Too many nested GOSUBS error

Don Coleman dcoleman at dgcreact.com
Tue Sep 19 08:43:23 PDT 2006


Win2000 clients; Win2000 Advanced Server;fP v5.0.13

I have a *clerk posting routine which occasionally errors with a 
"Too many nested GOSUB's message.  The client may see this error on 1-2
transactions/week out of 10,000+ transactions/week.  Below is the beginning
of the routine which errors on line #22.  There are only 5 GOSUB routines
and I cannot imagine a transaction which would test TRUE to nearly all 5
GOSUB condition statements.  

I guess my question is, since this is a looping process based on a index
flag (YESNO) where the application checks the file for any transactions
which have not yet been posted and if it finds any it posts them and marks
the flag as posted.  Since this app. only ends/exits at either the end of
the day or if it errors does the limit of 16 nested GOSUBS apply to each
transaction being posted or until the application has processed sufficient
transactions to exceed the limit of 16?

The GOSUB routine is noted after the beginning of the table.  I apologize
for the length of the GOSUB routine but I posted it in case my question is
ambigious.





Sep 19, 2006  10:23           File Name: KALOS                     Page   1
                             Processing: qs1

   1 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: end
   2 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
@ENTSEL  If: 
       Then: SHOW "\r(C)\r onnect  e \r(X)\r it"
   3 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: pushkey "C[ENTR]";end
   4 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
@KEYC    If: 
       Then: break off
   5 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL ASTERISK(1,YESNO), HALF_QTR(1,YESNO),
OVERRIDE_1(3,*)
             , OVERRIDE_2(3,.0), BLANK_1(1,*), SCAN_QT(8,.2)
   6 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL OVERRIDE_1_6(8,MDY/), OVERRIDE_7_14(8,*),
QTY_DIV_BY_
             30(10,.4), REM_DIV_BY_30(5,*), MAINT_REQ(1,ALLUP)
   7 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL PRT_DEST_OVER(2,ALLUP), QTY_DIV_PKG_SIZE(10,.4),
DAY_
             WEEK(1,.0), DELTIME_M_TH(6,*), LABEL(2,ALLUP)
   8 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL ON_DEMAND_AVAIL(1,YESNO),
PHARMASSIST_AVAIL(1,YESNO),
              ON_DEMAND(1,YESNO), PHARMASSIST(1,YESNO)
   9 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL PIGEON(1,YESNO), PRT_DEST(2,ALLUP),
TOT_QTY_DIV_QTY_S
             CAN(8,.2), PIG_ODD_QTY(10,.4), NOT_QS1(1,YESNO)
  10 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DECLARE LOCAL STATE(2,ALLUP)
  11 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: ON_DEMAND_AVAIL="Y";PHARMASSIST_AVAIL="Y"
  12 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: AA(1,*)="";AB(1,.0)="2"
  13 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
check    If: @TM ge "22:45:00" and @TM le "02:00:00"
       Then: exit
  14 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup kalos  k=AA   i=D -nx
  15 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: @SK eq "BRKY"
       Then: flushkey;exit
  16 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: SHOW "Press \r<BREAK>\r to terminate posting of KALOS data to
fileP
             ro Workflow application"
  17 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not kalos
       Then: flushkey;break on;sleep "15000";goto check
  18 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: kalos(108) eq "Y"
       Then: flushkey;break on;sleep "15000";goto check



Sep 19, 2006  10:23           File Name: KALOS                     Page   2
                             Processing: qs1

  19 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: rn(8,.0)=kalos(@RN)
  20 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup -  r=rn  -np
  21 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not kalos
       Then: beep;msgbox "\r UNABLE TO POST KALOS DATA TO filePro WORKFLOW
APPLI
             CATION";exit
  22 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 3 eq "P"
       Then: gosub rphck;goto check


RPHCK SUB-ROUTINE

Sep 19, 2006  10:23           File Name: KALOS                     Page   1
                             Processing: qs1

  63 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
rphck    If: 
       Then: PRT_DEST=""
  64 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup qs1  k=1    i=A -npx
  65 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not qs1
       Then: NOT_QS1="Y";goto newrx
  66 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: OVERRIDE_1_6=mid(47,"1","6")
  67 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (OVERRIDE_1_6 ne 10 or OVERRIDE_1_6 eq "") and
mid(qs1(50),"1","1")
              eq "U"
       Then: 108="Y";write;return
  68 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(qs1(50),"1","1") eq "U"
       Then: 108="Y";write;return
  69 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(qs1(50),"1","1") eq "N"
       Then:
qs1(5)=6;qs1(49)="2";qs1(53)=6;qs1(56)=qs1(25);qs1(54)=@TD;qs1(55)=
             2
  70 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(qs1(50),"1","1") eq "N" and qs1(100) lt "2"
       Then: qs1(100)="2"
  71 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(qs1(50),"1","1") eq "N") and (qs1(56) eq qs1(25)) and 27
ne "Y
             "
       Then: qs1(112)="Y";'Set-up Auto-Print flag for Kalos non-distribution
Rx'
             s
  72 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: OVERRIDE_1_6 ne 10
       Then: AC=33;goto zerovr
  73 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"7","1") eq "0"
       Then: AC="0";goto zerovr
  74 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"7","1") ge "1" and mid(47,"7","1") le "9"
       Then: AC=""{mid(47,"7","1")
  75 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"8","1") ge "0" and mid(47,"8","1") le "9"
       Then: AC=""{AC{mid(47,"8","1")
  76 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"9","1") ge "0" and mid(47,"9","1") le "9"
       Then: AC=""{AC{mid(47,"9","1")
  77 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"10","1") ge "0" and mid(47,"10","1") le "9"
       Then: AC=""{AC{mid(47,"10","1")
  78 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"11","1") ge "0" and mid(47,"11","1") le "9"
       Then: AC=""{AC{mid(47,"11","1")
  79 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
zerovr   If: 
       Then: AD=AC
  80 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: AD lt "1"
       Then: AD=33





Sep 19, 2006  10:23           File Name: KALOS                     Page   2
                             Processing: qs1

  81 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
skipit   If: 
       Then: lookup req = labelreq  k=11   i=A -nx
  82 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not req
       Then:
DELTIME_M_TH="";PRT_DEST_OVER="";MAINT_REQ="";LABEL="";STATE="";got
             o getprt
  83 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then:
DELTIME_M_TH=req(14);PRT_DEST_OVER=req(31);MAINT_REQ=req(3);LABEL=r
             eq(9);STATE=req(24)
  84 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
getprt   If: 
       Then:
QTY_DIV_BY_30=(33/"30");REM_DIV_BY_30=mid(QTY_DIV_BY_30,"6","5")
  85 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: PRT_DEST_OVER ne ""
       Then: PRT_DEST=PRT_DEST_OVER;goto nodet at 2
  86 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "HIV PREP KIT"
       Then: goto tables
  87 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "1/2" or 38 co "1/4" or 38 co "1/8"
       Then: ASTERISK="Y";gosub halftab
  88 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 39 co "1/2" or 39 co "1/4" or 39 co "1/8"
       Then: ASTERISK="Y";gosub halftab
  89 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 40 co "1/2" or 40 co "1/4" or 40 co "1/8"
       Then: ASTERISK="Y";gosub halftab
  90 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 41 co "1/2" or 41 co "1/4" or 41 co "1/8"
       Then: ASTERISK="Y";gosub halftab
  91 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "ORIGINAL" or 39 co "ORIGINAL" or 40 co "ORIGINAL" or 41
co "
             ORIGINAL"
       Then: ASTERISK="Y"
  92 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "DRAM" or 39 co "DRAM" or 40 co "DRAM" or 41 co "DRAM"
       Then: ASTERISK="Y"
  93 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "BOTTLE" or 39 co "BOTTLE" or 40 co "BOTTLE" or 41 co
"BOTTLE
             "
       Then: ASTERISK="Y"
  94 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 38 co "VIAL" or 39 co "VIAL" or 40 co "VIAL" or 41 co "VIAL"
       Then: goto ckass
  95 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 21 eq "*" and (11 eq "LARC" or 11 eq "OSP" or 11 eq "MACC" or
11 eq
              "BJCC" or 11 eq "EWCC" or 11 eq "HMCC")
       Then: goto ckass
  96 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 21 eq "*" and (11 eq "JBCC" or 11 eq "NOCC" or 11 eq "TCC" or
11 eq
              "WSKC" or 11 eq "ECCC")
       Then: goto ckass
  97 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 27 eq "Y" and (77 ge "2" and 77 le "5")
       Then: PRT_DEST="C2";goto nodet at 2;'changed per MSV 08/01/2006 lines
112 & 
             113 switched
  98 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(32,"1","5") eq "51129"
       Then: PRT_DEST="T";goto nodet at 2;'changed per MSV 08/01/2006 lines 112
& 1
             13 switched

Sep 19, 2006  10:23           File Name: KALOS                     Page   3
                             Processing: qs1

  99 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 27 eq "Y"
       Then: PRT_DEST="T";goto nodet at 2
 100 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 77 ge "2" and 77 le "5"
       Then: PRT_DEST="C";goto nodet at 2
 101 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: ASTERISK="*" or HALF_QTR="Y"
       Then: PRT_DEST="B";goto nodet at 2
 102 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 34 eq "Y" and STATE eq "SD"
       Then: goto ckass;'South Dakota Z-DOSE BUBBLE Rx
 103 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 eq ""
       Then: goto ckpig;'blank override skips to pigeon logic
 104 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 co "UNITDOSE" or 47 co "BOTTLE" or 47 co "BAXTER" or 47 co
"ORIG
             "
       Then: goto tables
 105 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 eq "2/BUBBLE" or 47 eq "3/BUBBLE" or 47 co "BAGGIE" or 47 co
"*S
             CV" or 47 co "VIAL"
       Then: goto ckass
 106 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: OVERRIDE_1_6=mid(47,"1","6");OVERRIDE_7_14=mid(47,"7","8")
 107 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: OVERRIDE_1_6 eq 10 and mid(40,"7","5") co "*CARD"
       Then: goto ckpig
 108 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","8") eq "*30/CARD"
       Then: goto ckpig
 109 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"1","5") eq "*CARD" or mid(47,"1","6") eq "*CARDS") and
(33
              eq "30" or REM_DIV_BY_30 eq ".0000")
       Then: goto ckpig
 110 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","1") ne "*"
       Then: goto ckseven
 111 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"2","1") ge "0" and mid(47,"2","1") le "9"
       Then: OVERRIDE_1=BLANK_1{mid(47,"2","1")
 112 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"3","1") ge "0" and mid(47,"3","1") le "9"
       Then: OVERRIDE_1=BLANK_1{OVERRIDE_1{mid(47,"3","1")
 113 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"4","1") ge "0" and mid(47,"4","1") le "9"
       Then: OVERRIDE_1=BLANK_1{OVERRIDE_1{mid(47,"4","1")
 114 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: OVERRIDE_2=OVERRIDE_1;goto ckpig
 115 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: OVERRIDE_2 gt "30" or (OVERRIDE_2 gt "1" and 47 co "/BUBBLE")
       Then: goto ckass;'check for PharmAssist eligibility for cards w/ qty
> 30
             
 116 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (OVERRIDE_2 gt "0" and OVERRIDE_2 lt "30" and 47 co "/CARD") or
(OV
             ERRIDE_2 gt "30" and 47 co "/CARD")
       Then: goto oddpig




Sep 19, 2006  10:23           File Name: KALOS                     Page   4
                             Processing: qs1

 117 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: ASTERISK eq "*"
       Then: goto nopig
 118 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: SCAN_QT=(33/49);TOT_QTY_DIV_QTY_SCAN=(33/SCAN_QT)
 119 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"3","5") co "/CARD" or mid(47,"4","5") co "/CARD" or
mid(47
             ,"5","5") co "/CARD") and (OVERRIDE_2 eq SCAN_QT)
       Then: goto ckpig
 120 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"3","5") co "/CARD" or mid(47,"4","5") co "/CARD"or
mid(47,
             "5","5") co "/CARD")and mid(SCAN_QT,"6","3") eq ".00"
       Then: goto ckpig
 121 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","4") eq "*RHU" or mid(47,"1","4") eq "*MHU"
       Then: goto ckpig
 122 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"3","9") co "TAB/CARD" or mid(47,"3","9") co
"TABS/CARD") a
             nd (OVERRIDE_2 eq SCAN_QT)
       Then: goto ckpig
 123 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"3","9") co "TAB/CARD" or mid(47,"3","9") co
"TABS/CARD") a
             nd (mid(TOT_QTY_DIV_QTY_SCAN,"6","3") eq ".00")
       Then: goto ckpig
 124 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"4","9") co "TAB/CARD" or mid(47,"4","9") co
"TABS/CARD") a
             nd (OVERRIDE_2 eq SCAN_QT)
       Then: goto ckpig
 125 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"4","9") co "TAB/CARD" or mid(47,"4","9") co
"TABS/CARD") a
             nd (mid(TOT_QTY_DIV_QTY_SCAN,"6","3") eq ".00")
       Then: goto ckpig
 126 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"5","9") co "TAB/CARD" or mid(47,"5","9") co
"TABS/CARD") a
             nd (OVERRIDE_2 eq SCAN_QT)
       Then: goto ckpig
 127 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(47,"4","9") co "TAB/CARD" or mid(47,"4","9") co
"TABS/CARD") a
             nd (mid(TOT_QTY_DIV_QTY_SCAN,"6","3") eq ".00")
       Then: goto ckpig
 128 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
ckseven  If: OVERRIDE_1_6 ne 10 or mid(47,"7","1") ne "*"
       Then: goto ckpig
 129 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"8","1") ge "0" and mid(47,"8","1") le "9"
       Then: OVERRIDE_1=BLANK_1{mid(47,"8","1")
 130 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"9","1") ge "0" and mid(47,"9","1") le "9"
       Then: OVERRIDE_1=BLANK_1{OVERRIDE_1{mid(47,"9","1")
 131 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"10","1") ge "0" and mid(47,"10","1") le "9"
       Then: OVERRIDE_1=BLANK_1{OVERRIDE_1{mid(47,"10","1")
 132 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: OVERRIDE_2=OVERRIDE_1
 133 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: OVERRIDE_2 gt "30"
       Then: goto ckass
 134 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: OVERRIDE_2 gt "1" and 47 co "BUBBLE"
       Then: goto ckass

Sep 19, 2006  10:23           File Name: KALOS                     Page   5
                             Processing: qs1

 135 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (OVERRIDE_2 gt "0" and OVERRIDE_2 lt "30" and 47 co "/CARD") or
(OV
             ERRIDE_2 gt "30" and 47 co "/CARD")
       Then: goto nopig
 136 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 21 eq "*" and (11 eq "6B" or 11 eq "2F" or 11 eq "6K" or 11 eq
"4E"
             )
       Then: goto ckpig
 137 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 21 eq "*" and (11 eq "4N" or 11 eq "4F")
       Then: goto ckass
 138 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
ckpig    If: MAINT_REQ eq "C"
       Then: goto pigeonC
 139 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "Z"
       Then: goto pigeonZ
 140 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ ne "M" and (mid(47,"1","5") eq "*CARD" or
mid(47,"1","8")
              eq "*30/CARD")
       Then: goto othpig
 141 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: OVERRIDE_1_6=mid(47,"1","6")
 142 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (OVERRIDE_1_6 eq 10 and mid(47,"7","5") eq "*CARD") or
(OVERRIDE_1_
             6 eq 10 and mid(47,"7","8") eq "*30/CARD")
       Then: goto othpig
 143 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "M"
       Then: goto tables
 144 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: goto ckass
 145 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
pigeonC  If: MAINT_REQ eq "C" and mid(48,"3","1") eq "*" and REM_DIV_BY_30
eq ".
             0000"
       Then: PIGEON="Y";PRT_DEST="P";goto nodet at 2
 146 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "C" and mid(48,"3","1") eq "#" and REM_DIV_BY_30
eq ".
             0000"
       Then: PIGEON="Y";PRT_DEST="P2";goto nodet at 2
 147 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "C" and mid(48,"3","1") eq "%" and REM_DIV_BY_30
eq ".
             0000"
       Then: PIGEON="Y";PRT_DEST="P3";goto nodet at 2
 148 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "C" and mid(48,"3","1") eq "$" and REM_DIV_BY_30
eq ".
             0000"
       Then: PIGEON="Y";PRT_DEST="P4";goto nodet at 2
 149 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: goto oddpig
 150 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
pigeonZ  If: (MAINT_REQ eq "Z" and mid(48,"3","1") eq "*" and SCAN_QT="30")
       Then: PIGEON="Y";PRT_DEST="P";goto nodet at 2
 151 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (MAINT_REQ eq "Z" and mid(48,"3","1") eq "#" and SCAN_QT="30")
       Then: PIGEON="Y";PRT_DEST="P2";goto nodet at 2
 152 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (MAINT_REQ eq "Z" and mid(48,"3","1") eq "%" and SCAN_QT="30")
       Then: PIGEON="Y";PRT_DEST="P3";goto nodet at 2

Sep 19, 2006  10:23           File Name: KALOS                     Page   6
                             Processing: qs1

 153 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (MAINT_REQ eq "Z" and mid(48,"3","1") eq "$" and SCAN_QT="30")
       Then: PIGEON="Y";PRT_DEST="P4";goto nodet at 2
 154 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
othpig   If: mid(47,"1","8") eq "*30/CARD" and mid(48,"3","1") eq "*"
       Then: PIGEON="Y";PRT_DEST="P";goto nodet at 2
 155 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","8") eq "*30/CARD" and mid(48,"3","1") eq "#"
       Then: PIGEON="Y";PRT_DEST="P2";goto nodet at 2
 156 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","8") eq "*30/CARD" and mid(48,"3","1") eq "%"
       Then: PIGEON="Y";PRT_DEST="P3";goto nodet at 2
 157 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","8") eq "*30/CARD" and mid(48,"3","1") eq "$"
       Then: PIGEON="Y";PRT_DEST="P4";goto nodet at 2
 158 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","5") eq "*CARD" and mid(48,"3","1") eq "*"
       Then: PIGEON="Y";PRT_DEST="P";goto nodet at 2
 159 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","5") eq "*CARD" and mid(48,"3","1") eq "#"
       Then: PIGEON="Y";PRT_DEST="P2";goto nodet at 2
 160 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","5") eq "*CARD" and mid(48,"3","1") eq "%"
       Then: PIGEON="Y";PRT_DEST="P3";goto nodet at 2
 161 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","5") eq "*CARD" and mid(48,"3","1") eq "$"
       Then: PIGEON="Y";PRT_DEST="P4";goto nodet at 2
 162 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
oddpig   If: OVERRIDE_2 gt "0"
       Then: AI=mid(32,"1","9")&OVERRIDE_2;gosub ckodd;'Check Card or Z
facility
              w/ override in position #1 for quantity multiples
 163 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: PIGEON eq "Y"
       Then: PRT_DEST="L";goto nodet at 2
 164 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 eq "" and MAINT_REQ eq "C"
       Then: AI(18,*)=mid(32,"1","9")&33;gosub ckodd;'Check 'pigqty' for
Card fa
             cility w/ blank override
 165 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: PIGEON eq "Y"
       Then: PRT_DEST="L";goto nodet at 2
 166 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 eq "" and MAINT_REQ eq "Z"
       Then: AI=mid(32,"1","9")&SCAN_QT;gosub ckodd;'Check 'pigqty' for Z
facili
             ty w/ blank override & exact match on scanned qty
 167 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: PIGEON eq "Y"
       Then: PRT_DEST="L";goto nodet at 2
 168 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 47 eq "" and MAINT_REQ eq "C"
       Then: AI=mid(32,"1","9");gosub oddmult;'Check for Card w/ blank
override 
             & quantity a multiple of 'pigqty'
 169 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: PIGEON eq "Y"
       Then: PRT_DEST="L";goto nodet at 2
 170 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
nopig    If: (78 eq 33) and (78 ge "500")
       Then: goto tables





Sep 19, 2006  10:23           File Name: KALOS                     Page   7
                             Processing: qs1

 171 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: QTY_DIV_PKG_SIZE=(33/78)
 172 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (mid(QTY_DIV_PKG_SIZE,"6","5") eq ".0000") and (78 ge "100")
       Then: goto tables
 173 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
ckmts    If: ON_DEMAND_AVAIL ne "Y" or SCAN_QT gt "30"
       Then: goto ckass
 174 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: DAY_WEEK=DOW(@TD)
 175 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: DELTIME_M_TH eq "1:00PM" and (@TM ge "13:30:00" and @TM le
"20:00:0
             0") and (DAY_WEEK ge "2" and DAY_WEEK le "6")
       Then: goto ckass
 176 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: DELTIME_M_TH eq "6:00PM" and (@TM ge "13:30:00" and @TM le
"20:00:0
             0") and DAY_WEEK eq "7"
       Then: goto ckass
 177 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: (DELTIME_M_TH eq "1:00PM" or DELTIME_M_TH eq "2:00PM") and (@TM
ge 
             "16:00:00" and @TM le "20:00:00") and DAY_WEEK eq "7"
       Then: goto ckass
 178 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: @TM ge "16:45:00" and @TM le "20:00:00"
       Then: goto ckass
 179 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup mts = mtsndc  k=32   i=A -nx
 180 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not mts
       Then: goto ckass
 181 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "C"
       Then: ON_DEMAND="Y";PRT_DEST="M";PHARMASSIST="";PIGEON="";putenv
"PFPOSTP
             RINT",""
 182 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: MAINT_REQ eq "Z" and SCAN_QT le "30"
       Then: ON_DEMAND="Y";PRT_DEST="M";PHARMASSIST="";PIGEON="";putenv
"PFPOSTP
             RINT",""
 183 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: ON_DEMAND eq "Y"
       Then: goto tables
 184 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
ckass    If: PHARMASSIST_AVAIL ne "Y"
       Then: goto tables
 185 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(47,"1","2") eq "*U"
       Then: goto tables
 186 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup ass = pharmndc  k=32   i=A -nx
 187 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not ass
       Then: goto tables
 188 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: PHARMASSIST="Y";ON_DEMAND="";PIGEON=""




Sep 19, 2006  10:23           File Name: KALOS                     Page   8
                             Processing: qs1

 189 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: ass(6) eq "1"
       Then: PRT_DEST="V1";putenv "PFPOSTPRINT","C:\PRINTWIZ\PRINTWIZ.EXE
/P\"I-
             4308V1\" C:\PRINTWIZ\HARDCOPY.TXT";goto nodet at 2
 190 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: ass(6) eq "2"
       Then: PRT_DEST="V2";putenv "PFPOSTPRINT","C:\PRINTWIZ\PRINTWIZ.EXE
/P\"I-
             4308V2\" C:\PRINTWIZ\HARDCOPY.TXT";goto nodet at 2
 191 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
tables   If: mid(48,"1","1") eq "Z"
       Then: PRT_DEST="Z";goto nodet at 2
 192 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "Y"
       Then: PRT_DEST="Y";goto nodet at 2
 193 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "X"
       Then: PRT_DEST="X";goto nodet at 2
 194 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "A" or mid(48,"1","1") eq "B" or
mid(48,"1","1")
              eq "C" or mid(48,"1","1") eq "J"
       Then: PRT_DEST="A";goto nodet at 2
 195 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","2") eq "FR" or mid(48,"1","3") eq "MED"
       Then: PRT_DEST="A";goto nodet at 2
 196 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "D" or mid(48,"1","1") eq "E" or
mid(48,"1","2")
              eq "IV"
       Then: PRT_DEST="D";goto nodet at 2
 197 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "F" or mid(48,"1","1") eq "G"
       Then: PRT_DEST="F";goto nodet at 2
 198 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","2") eq "H" or mid(48,"1","1") eq "I"
       Then: PRT_DEST="H";goto nodet at 2
 199 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: mid(48,"1","1") eq "L"
       Then: PRT_DEST="B";goto nodet at 2
 200 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: PRT_DEST="Z"
 201 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
nodet at 2  If: (27 eq "Y" or 11 eq "LX") and mid(32,"1","5") ne "51129"
       Then: goto batchit
 202 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: goto finish
 203 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
batchit  If: 
       Then: lookup pqu = pqueue  r=free  -n
 204 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not pqu
       Then: beep;msgbox "\r PRINTER QUEUE FILE UNAVAILABLE";return
 205 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: pqu(1)=1;pqu(2)=PRT_DEST;qs1(16)=pqu(2)
 206 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: DELTIME_M_TH eq "1:00PM" or 109 eq "1"
       Then: pqu(3)="A";goto gotime





Sep 19, 2006  10:23           File Name: KALOS                     Page   9
                             Processing: qs1

 207 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: DELTIME_M_TH eq "2:00PM"
       Then: pqu(3)="C";goto gotime
 208 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: pqu(3)="B"
 209 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
gotime   If: 
       Then:
pqu(4)=32;pqu(5)=AD;pqu(6)=@TM;pqu(7)=111;pqu(11)=11;pqu(15)=10;wri
             te pqu
 210 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
finish   If: 
       Then:
108="Y";write;qs1(144)=PHARMASSIST;qs1(151)=ON_DEMAND;qs1(81)=PIGEO
             N;qs1(16)=PRT_DEST;write qs1;close qs1
 211 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup det = qs1det  r=free  -n
 212 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not det
       Then: return
 213 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: det(1)=1;det(2)="2";det(3)=@TD;det(4)=@TM;det(5)=6;det(6)=33
 214 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: write det
 215 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: lookup ket = kalosdet  r=free  -n
 216 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: not ket
       Then: return
 217 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: ket(1)=1;ket(2)="2";ket(3)=@TD;ket(4)=@TM;ket(5)=33;ket(6)=49
 218 -------   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
         If: 
       Then: ket(7)="Y";write ket;return



Don Coleman
Donald G. Coleman, Consultant
402 Andrew Circle
Indiana, PA 15701
dcoleman at dgcreact.com
(724) 349-6302




More information about the Filepro-list mailing list