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