ASURO76P ; IHS/ITSC/LMH -PRINT RPT 76 DATA FROM ASURX(76 ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 76, Analysis of Stock Issues
; Report.
PRINT ;EP;PRIMARY ENTRY POINT FOR REPORT 76
Q ;WAR 5/21/99
I '$D(IO) D HOME^%ZIS
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
S ZTRTN="PSER^ASURO76P",ZTDESC="SAMS RPT 76" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
D U^ASUUZIS
S ASUV("RPT")="R76",ASUC("PG")=""
I ($D(ASUK("DT"))#10)'=1 D DATE^ASUUDATE
D P1 S (ASUX("SST"),ASUX("USR"),ASUX("ACC"))=""
F S ASUX("SST")=$O(^XTMP("ASUR","R76",ASUX("SST"))) Q:ASUX("SST")="" D
.F S ASUX("USR")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"))) Q:'ASUX("USR") D
..S ASUX("REQ")=ASUX("SST")_$E(ASUX("USR"),3,6)
..F S ASUX("ACC")=$O(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"),ASUX("ACC"))) Q:'ASUX("ACC") S ASUC("TR")=^(ASUX("ACC")) D
...F ASUV("FIELD")=1:1:22 D
....S ASUC(ASUV("FIELD"),0,ASUX("ACC"))=+$P(ASUC("TR"),U,ASUV("FIELD"))
..D P3,HEADER,P1
D ZAP0
I ASUK("PTRSEL")]"" Q
D C^ASUUZIS
Q
P1 ;EP ;
F ASUV("ACC")=1,2,3,4,5,9 D
.F ASUV("FIELD")=1:1:26 D
..S ASUC(ASUV("FIELD"),0,ASUV("ACC"))=0
.F ASUV("FIELD")=15:1:18 D
..S ASUC(ASUV("FIELD"),"%",ASUV("ACC"))=0
PTOT ;
F ASUV("ACC")=1,2,3,4,5,9 D
.S (ASUC(8,"%",ASUV("ACC")),ASUC(10,"%",ASUV("ACC")),ASUC(12,"%",ASUV("ACC")),ASUC(14,"%",ASUV("ACC")))=0
.;FIELDS 1,23,24,25 AND 26 ARE COMPUTED RATHER THAN BEING IN THE DATABASE
.S (ASUC(1,0,ASUV("ACC")),ASUC(23,0,ASUV("ACC")),ASUC(24,0,ASUV("ACC")),ASUC(25,0,ASUV("ACC")),ASUC(26,0,ASUV("ACC")))=0
F ASUV("FIELD")=1:1:26 D
.S ASUC(ASUV("FIELD"))=0
Q
ZAP0 ;EP; -CLEAN UP VARIABLES
K ASUR,ASUC,ASUV,ASURZX
Q
Q:$G(ASUX("REQ"))']""
S ASUV("SST")="",ASUV("USR")="",ASUC("PG")=ASUC("PG")+1
D:ASUC("PG")>1 PAZ^ASUURHDR
W @IOF,!?1,"REPORT #",ASUV("RPT")," ANALYSIS OF ISSUES BY ",$S(ASUV("RPT")=76:"USER",ASUV("RPT")=77:"SUB STATION",ASUV("RPT")=78:"AREA",1:"")
W ?75,"DATE: ",ASUK("DT"),?104,"PAGE: ",ASUC("PG")
W !?1,"AREA: ",ASUL(1,"AR","AP")," -",?10,ASUL(1,"AR","NM")
D SST^ASULDIRR(ASUX("SST")) ;,USR^ASULDIRR(ASUX("USR"))
I ASUV("RPT")'=78 W !?1,"SUBSTAT: ",ASUL(18,"SST")," - ",ASUL(18,"SST","NM")
D REQ^ASULDIRR(ASUX("REQ"))
I ASUV("RPT")=76 W !?1,"USER: ",ASUL(20,"REQ")," - ",ASUL(19,"USR","NM")
W !!?51,"DRUGS MEDICAL SUBSIST LABORATORY OFF/ADMIN ALL OTHER TOTAL"
F ASUV("FIELD")=7,8,"P8",9,10,"P10",11,12,"P12",13,14,"P14",1,25,23,24,15,"P15",16,"P16",17,"P17",18,"P18",19,20,21,22 D PRLINE
F ASUV("FIELD")=5,6,2,3 D PRVALUE
Q
PRLINE ;
I ASUV("FIELD")["P" D
.S ASUV("%")=1,ASUV("FIELD")=$P(ASUV("FIELD"),"P",2),ASUV("ROUT")="PCT"
E D
.S ASUV("ROUT")="PR"_ASUV("FIELD"),ASUV("%")=0
D @ASUV("ROUT")
F ASUV("ACC")=1:1:5,9,10 D
.S ASUV("POS")=$S(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
.I ASUV("ACC")=10 D
..I ASUV("%") D
...W ?117,$J($FN(ASUC(ASUV("FIELD"),"%"),",",1),10)_" %"
..E D
...W ?117,$J(ASUC(ASUV("FIELD")),10)
.E D
..I ASUV("%") D
...W ?ASUV("POS"),$J($FN(ASUC(ASUV("FIELD"),"%",ASUV("ACC")),",",1),10)_" %"
..E D
...W ?ASUV("POS"),$J(ASUC(ASUV("FIELD"),0,ASUV("ACC")),10)
Q
PRVALUE ;
S ASUV("ROUT")="PR"_ASUV("FIELD"),ASUV("%")=0
D @ASUV("ROUT")
F ASUV("ACC")=1:1:5,9,10 D
.S ASUV("POS")=$S(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
.I ASUV("ACC")=10 D
..W ?117,$J($FN(ASUC(ASUV("FIELD")),",",0),10)
.E D
..W ?ASUV("POS"),$J($FN(ASUC(ASUV("FIELD"),0,ASUV("ACC")),",",0),10)
Q
PR3 ;
PR6 ;
PR8 ;
PR10 ;
PR12 ;
PR14 ;
PR20 ;
PR22 ;
PR25 ;
PR24 ;
W !?31,"YEAR-TO-DATE" Q
PR7 ;
W !!?1,"SCHEDULED STOCK ISSUE REQUEST" G PR0
PR11 ;
W !!?1,"UNSCHEDULED STOCK ISSUE REQUEST" G PR0
PR1 ;
W !!?1,"TOTAL STOCK ISSUE REQUEST" G PR0
PR19 ;
W !!?1,"DIRECT ISSUE"
PR0 ;
W !?11,"NUMBER LINE ITEMS -CURRENT MONTH" Q
PR9 ;
PR13 ;
PR21 ;
PR23 ;
W !!?11,"NUMBER DOCUMENTS -CURRENT MONTH" Q
PR15 ;
W !!?1,"NUMBER LINE ITEMS WITH ZERO ISSUE YTD" Q
PR16 ;
W !!?1,"NUMBER LINE ITEMS WITH PARTIAL ISSUE YTD" Q
PR17 ;
W !!?1,"NUMBER LINE ITEMS BACK ORDERED YTD" Q
PR18 ;
W !!?1,"NUMBER LINE ITEMS WITH QUANTITY ADJUSTED YTD" Q
PR26 ;
W !!?1,"NUMBER LINE ITEMS PENDING B/O RELEASE" Q
PR5 ;
W !!?1,"VALUE OF DIRECT ISSUES -CURRENT MONTH" Q
PR2 ;
W !!?1,"VALUE OF STOCK ISSUES -CURRENT MONTH" Q
PCT ;
W !?31,"PERCENT" Q
P3 ;EP ;
F ASUV("ACC")=1:1:5,9 D
.S ASUC(1,0,ASUV("ACC"))=ASUC(7,0,ASUV("ACC"))+ASUC(11,0,ASUV("ACC"))
.S ASUC(23,0,ASUV("ACC"))=ASUC(9,0,ASUV("ACC"))+ASUC(13,0,ASUV("ACC"))
.S ASUC(24,0,ASUV("ACC"))=ASUC(10,0,ASUV("ACC"))+ASUC(14,0,ASUV("ACC"))
.S ASUC(24)=ASUC(24)+ASUC(24,0,ASUV("ACC"))
.S ASURZX(1)=ASUC(24,0,ASUV("ACC")),ASURZX(2)=ASUC(10,0,ASUV("ACC")) D CALC S ASUC(10,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(24,0,ASUV("ACC")),ASURZX(2)=ASUC(14,0,ASUV("ACC")) D CALC S ASUC(14,"%",ASUV("ACC"))=ASURZX(3)
.S ASUC(25,0,ASUV("ACC"))=ASUC(8,0,ASUV("ACC"))+ASUC(12,0,ASUV("ACC"))
.S ASUC(25)=ASUC(25)+ASUC(25,0,ASUV("ACC"))
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(8,0,ASUV("ACC")) D CALC S ASUC(8,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(12,0,ASUV("ACC")) D CALC S ASUC(12,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(15,0,ASUV("ACC")) D CALC S ASUC(15,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(16,0,ASUV("ACC")) D CALC S ASUC(16,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(17,0,ASUV("ACC")) D CALC S ASUC(17,"%",ASUV("ACC"))=ASURZX(3)
.S ASURZX(1)=ASUC(25,0,ASUV("ACC")),ASURZX(2)=ASUC(18,0,ASUV("ACC")) D CALC S ASUC(18,"%",ASUV("ACC"))=ASURZX(3)
F ASUV("FIELD")=1:1:3,5:1:23 D
.F ASUV("ACC")=1:1:5,9 D
..S ASUC(ASUV("FIELD"))=ASUC(ASUV("FIELD"))+ASUC(ASUV("FIELD"),0,ASUV("ACC"))
S ASURZX(1)=ASUC(24),ASURZX(2)=ASUC(10) D CALC S ASUC(10,"%")=ASURZX(3)
S ASURZX(1)=ASUC(24),ASURZX(2)=ASUC(14) D CALC S ASUC(14,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(16) D CALC S ASUC(16,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(18) D CALC S ASUC(18,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(8) D CALC S ASUC(8,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(12) D CALC S ASUC(12,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(15) D CALC S ASUC(15,"%")=ASURZX(3)
S ASURZX(1)=ASUC(25),ASURZX(2)=ASUC(17) D CALC S ASUC(17,"%")=ASURZX(3)
Q
CALC ;
I ASURZX(1)'>0 S ASURZX(3)=0 Q
S ASURZX(3)=(ASURZX(2)/ASURZX(1))*100
Q
ASURO76P ; IHS/ITSC/LMH -PRINT RPT 76 DATA FROM ASURX(76 ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 76, Analysis of Stock Issues
+3 ; Report.
PRINT ;EP;PRIMARY ENTRY POINT FOR REPORT 76
+1 ;WAR 5/21/99
QUIT
+2 IF '$DATA(IO)
DO HOME^%ZIS
+3 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+4 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+5 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+6 SET ZTRTN="PSER^ASURO76P"
SET ZTDESC="SAMS RPT 76"
DO O^ASUUZIS
+7 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+8 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 DO U^ASUUZIS
+2 SET ASUV("RPT")="R76"
SET ASUC("PG")=""
+3 IF ($DATA(ASUK("DT"))#10)'=1
DO DATE^ASUUDATE
+4 DO P1
SET (ASUX("SST"),ASUX("USR"),ASUX("ACC"))=""
+5 FOR
SET ASUX("SST")=$ORDER(^XTMP("ASUR","R76",ASUX("SST")))
IF ASUX("SST")=""
QUIT
Begin DoDot:1
+6 FOR
SET ASUX("USR")=$ORDER(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR")))
IF 'ASUX("USR")
QUIT
Begin DoDot:2
+7 SET ASUX("REQ")=ASUX("SST")_$EXTRACT(ASUX("USR"),3,6)
+8 FOR
SET ASUX("ACC")=$ORDER(^XTMP("ASUR","R76",ASUX("SST"),ASUX("USR"),ASUX("ACC")))
IF 'ASUX("ACC")
QUIT
SET ASUC("TR")=^(ASUX("ACC"))
Begin DoDot:3
+9 FOR ASUV("FIELD")=1:1:22
Begin DoDot:4
+10 SET ASUC(ASUV("FIELD"),0,ASUX("ACC"))=+$PIECE(ASUC("TR"),U,ASUV("FIELD"))
End DoDot:4
End DoDot:3
+11 DO P3
DO HEADER
DO P1
End DoDot:2
End DoDot:1
+12 DO ZAP0
+13 IF ASUK("PTRSEL")]""
QUIT
+14 DO C^ASUUZIS
+15 QUIT
P1 ;EP ;
+1 FOR ASUV("ACC")=1,2,3,4,5,9
Begin DoDot:1
+2 FOR ASUV("FIELD")=1:1:26
Begin DoDot:2
+3 SET ASUC(ASUV("FIELD"),0,ASUV("ACC"))=0
End DoDot:2
+4 FOR ASUV("FIELD")=15:1:18
Begin DoDot:2
+5 SET ASUC(ASUV("FIELD"),"%",ASUV("ACC"))=0
End DoDot:2
End DoDot:1
PTOT ;
+1 FOR ASUV("ACC")=1,2,3,4,5,9
Begin DoDot:1
+2 SET (ASUC(8,"%",ASUV("ACC")),ASUC(10,"%",ASUV("ACC")),ASUC(12,"%",ASUV("ACC")),ASUC(14,"%",ASUV("ACC")))=0
+3 ;FIELDS 1,23,24,25 AND 26 ARE COMPUTED RATHER THAN BEING IN THE DATABASE
+4 SET (ASUC(1,0,ASUV("ACC")),ASUC(23,0,ASUV("ACC")),ASUC(24,0,ASUV("ACC")),ASUC(25,0,ASUV("ACC")),ASUC(26,0,ASUV("ACC")))=0
End DoDot:1
+5 FOR ASUV("FIELD")=1:1:26
Begin DoDot:1
+6 SET ASUC(ASUV("FIELD"))=0
End DoDot:1
+7 QUIT
ZAP0 ;EP; -CLEAN UP VARIABLES
+1 KILL ASUR,ASUC,ASUV,ASURZX
+2 QUIT
+1 IF $GET(ASUX("REQ"))']""
QUIT
+2 SET ASUV("SST")=""
SET ASUV("USR")=""
SET ASUC("PG")=ASUC("PG")+1
+3 IF ASUC("PG")>1
DO PAZ^ASUURHDR
+4 WRITE @IOF,!?1,"REPORT #",ASUV("RPT")," ANALYSIS OF ISSUES BY ",$SELECT(ASUV("RPT")=76:"USER",ASUV("RPT")=77:"SUB STATION",ASUV("RPT")=78:"AREA",1:"")
+5 WRITE ?75,"DATE: ",ASUK("DT"),?104,"PAGE: ",ASUC("PG")
+6 WRITE !?1,"AREA: ",ASUL(1,"AR","AP")," -",?10,ASUL(1,"AR","NM")
+7 ;,USR^ASULDIRR(ASUX("USR"))
DO SST^ASULDIRR(ASUX("SST"))
+8 IF ASUV("RPT")'=78
WRITE !?1,"SUBSTAT: ",ASUL(18,"SST")," - ",ASUL(18,"SST","NM")
+9 DO REQ^ASULDIRR(ASUX("REQ"))
+10 IF ASUV("RPT")=76
WRITE !?1,"USER: ",ASUL(20,"REQ")," - ",ASUL(19,"USR","NM")
+11 WRITE !!?51,"DRUGS MEDICAL SUBSIST LABORATORY OFF/ADMIN ALL OTHER TOTAL"
+12 FOR ASUV("FIELD")=7,8,"P8",9,10,"P10",11,12,"P12",13,14,"P14",1,25,23,24,15,"P15",16,"P16",17,"P17",18,"P18",19,20,21,22
DO PRLINE
+13 FOR ASUV("FIELD")=5,6,2,3
DO PRVALUE
+14 QUIT
PRLINE ;
+1 IF ASUV("FIELD")["P"
Begin DoDot:1
+2 SET ASUV("%")=1
SET ASUV("FIELD")=$PIECE(ASUV("FIELD"),"P",2)
SET ASUV("ROUT")="PCT"
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET ASUV("ROUT")="PR"_ASUV("FIELD")
SET ASUV("%")=0
End DoDot:1
+5 DO @ASUV("ROUT")
+6 FOR ASUV("ACC")=1:1:5,9,10
Begin DoDot:1
+7 SET ASUV("POS")=$SELECT(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
+8 IF ASUV("ACC")=10
Begin DoDot:2
+9 IF ASUV("%")
Begin DoDot:3
+10 WRITE ?117,$JUSTIFY($FNUMBER(ASUC(ASUV("FIELD"),"%"),",",1),10)_" %"
End DoDot:3
+11 IF '$TEST
Begin DoDot:3
+12 WRITE ?117,$JUSTIFY(ASUC(ASUV("FIELD")),10)
End DoDot:3
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 IF ASUV("%")
Begin DoDot:3
+15 WRITE ?ASUV("POS"),$JUSTIFY($FNUMBER(ASUC(ASUV("FIELD"),"%",ASUV("ACC")),",",1),10)_" %"
End DoDot:3
+16 IF '$TEST
Begin DoDot:3
+17 WRITE ?ASUV("POS"),$JUSTIFY(ASUC(ASUV("FIELD"),0,ASUV("ACC")),10)
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
PRVALUE ;
+1 SET ASUV("ROUT")="PR"_ASUV("FIELD")
SET ASUV("%")=0
+2 DO @ASUV("ROUT")
+3 FOR ASUV("ACC")=1:1:5,9,10
Begin DoDot:1
+4 SET ASUV("POS")=$SELECT(ASUV("ACC")=1:45,ASUV("ACC")=2:57,ASUV("ACC")=3:69,ASUV("ACC")=4:81,ASUV("ACC")=5:93,1:105)
+5 IF ASUV("ACC")=10
Begin DoDot:2
+6 WRITE ?117,$JUSTIFY($FNUMBER(ASUC(ASUV("FIELD")),",",0),10)
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 WRITE ?ASUV("POS"),$JUSTIFY($FNUMBER(ASUC(ASUV("FIELD"),0,ASUV("ACC")),",",0),10)
End DoDot:2
End DoDot:1
+9 QUIT
PR3 ;
PR6 ;
PR8 ;
PR10 ;
PR12 ;
PR14 ;
PR20 ;
PR22 ;
PR25 ;
PR24 ;
+1 WRITE !?31,"YEAR-TO-DATE"
QUIT
PR7 ;
+1 WRITE !!?1,"SCHEDULED STOCK ISSUE REQUEST"
GOTO PR0
PR11 ;
+1 WRITE !!?1,"UNSCHEDULED STOCK ISSUE REQUEST"
GOTO PR0
PR1 ;
+1 WRITE !!?1,"TOTAL STOCK ISSUE REQUEST"
GOTO PR0
PR19 ;
+1 WRITE !!?1,"DIRECT ISSUE"
PR0 ;
+1 WRITE !?11,"NUMBER LINE ITEMS -CURRENT MONTH"
QUIT
PR9 ;
PR13 ;
PR21 ;
PR23 ;
+1 WRITE !!?11,"NUMBER DOCUMENTS -CURRENT MONTH"
QUIT
PR15 ;
+1 WRITE !!?1,"NUMBER LINE ITEMS WITH ZERO ISSUE YTD"
QUIT
PR16 ;
+1 WRITE !!?1,"NUMBER LINE ITEMS WITH PARTIAL ISSUE YTD"
QUIT
PR17 ;
+1 WRITE !!?1,"NUMBER LINE ITEMS BACK ORDERED YTD"
QUIT
PR18 ;
+1 WRITE !!?1,"NUMBER LINE ITEMS WITH QUANTITY ADJUSTED YTD"
QUIT
PR26 ;
+1 WRITE !!?1,"NUMBER LINE ITEMS PENDING B/O RELEASE"
QUIT
PR5 ;
+1 WRITE !!?1,"VALUE OF DIRECT ISSUES -CURRENT MONTH"
QUIT
PR2 ;
+1 WRITE !!?1,"VALUE OF STOCK ISSUES -CURRENT MONTH"
QUIT
PCT ;
+1 WRITE !?31,"PERCENT"
QUIT
P3 ;EP ;
+1 FOR ASUV("ACC")=1:1:5,9
Begin DoDot:1
+2 SET ASUC(1,0,ASUV("ACC"))=ASUC(7,0,ASUV("ACC"))+ASUC(11,0,ASUV("ACC"))
+3 SET ASUC(23,0,ASUV("ACC"))=ASUC(9,0,ASUV("ACC"))+ASUC(13,0,ASUV("ACC"))
+4 SET ASUC(24,0,ASUV("ACC"))=ASUC(10,0,ASUV("ACC"))+ASUC(14,0,ASUV("ACC"))
+5 SET ASUC(24)=ASUC(24)+ASUC(24,0,ASUV("ACC"))
+6 SET ASURZX(1)=ASUC(24,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(10,0,ASUV("ACC"))
DO CALC
SET ASUC(10,"%",ASUV("ACC"))=ASURZX(3)
+7 SET ASURZX(1)=ASUC(24,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(14,0,ASUV("ACC"))
DO CALC
SET ASUC(14,"%",ASUV("ACC"))=ASURZX(3)
+8 SET ASUC(25,0,ASUV("ACC"))=ASUC(8,0,ASUV("ACC"))+ASUC(12,0,ASUV("ACC"))
+9 SET ASUC(25)=ASUC(25)+ASUC(25,0,ASUV("ACC"))
+10 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(8,0,ASUV("ACC"))
DO CALC
SET ASUC(8,"%",ASUV("ACC"))=ASURZX(3)
+11 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(12,0,ASUV("ACC"))
DO CALC
SET ASUC(12,"%",ASUV("ACC"))=ASURZX(3)
+12 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(15,0,ASUV("ACC"))
DO CALC
SET ASUC(15,"%",ASUV("ACC"))=ASURZX(3)
+13 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(16,0,ASUV("ACC"))
DO CALC
SET ASUC(16,"%",ASUV("ACC"))=ASURZX(3)
+14 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(17,0,ASUV("ACC"))
DO CALC
SET ASUC(17,"%",ASUV("ACC"))=ASURZX(3)
+15 SET ASURZX(1)=ASUC(25,0,ASUV("ACC"))
SET ASURZX(2)=ASUC(18,0,ASUV("ACC"))
DO CALC
SET ASUC(18,"%",ASUV("ACC"))=ASURZX(3)
End DoDot:1
+16 FOR ASUV("FIELD")=1:1:3,5:1:23
Begin DoDot:1
+17 FOR ASUV("ACC")=1:1:5,9
Begin DoDot:2
+18 SET ASUC(ASUV("FIELD"))=ASUC(ASUV("FIELD"))+ASUC(ASUV("FIELD"),0,ASUV("ACC"))
End DoDot:2
End DoDot:1
+19 SET ASURZX(1)=ASUC(24)
SET ASURZX(2)=ASUC(10)
DO CALC
SET ASUC(10,"%")=ASURZX(3)
+20 SET ASURZX(1)=ASUC(24)
SET ASURZX(2)=ASUC(14)
DO CALC
SET ASUC(14,"%")=ASURZX(3)
+21 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(16)
DO CALC
SET ASUC(16,"%")=ASURZX(3)
+22 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(18)
DO CALC
SET ASUC(18,"%")=ASURZX(3)
+23 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(8)
DO CALC
SET ASUC(8,"%")=ASURZX(3)
+24 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(12)
DO CALC
SET ASUC(12,"%")=ASURZX(3)
+25 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(15)
DO CALC
SET ASUC(15,"%")=ASURZX(3)
+26 SET ASURZX(1)=ASUC(25)
SET ASURZX(2)=ASUC(17)
DO CALC
SET ASUC(17,"%")=ASURZX(3)
+27 QUIT
CALC ;
+1 IF ASURZX(1)'>0
SET ASURZX(3)=0
QUIT
+2 SET ASURZX(3)=(ASURZX(2)/ASURZX(1))*100
+3 QUIT
