ASURM74P ; IHS/ITSC/LMH -ISS ANAL BY LOC ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;prints report 74, Stock Issues/Budget ;Analysis by Location Report.
EN ;EP;PRIME
Q ;WAR 5/21/99
D:'$D(IO) HOME^%ZIS I '$D(DUZ(2)) W !,"Run from Kernel only" Q
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
S ZTRTN="PSER^ASURM74P",ZTDESC="SAMS RPT 74" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;TMQ
S ASUF("HDR")=1,X=$O(^XTMP("ASUR","R74","")),ASUF("RPT75")=+$G(ASUF("RPT75"))
I ASUF("RPT75") K ^XTMP("ASUR","R75") S ^XTMP("ASUR","R75",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
D U^ASUUZIS S ASUV("TOT")="""TOT""" D P1 G:'$D(^XTMP("ASUR","R74")) END
S (ASUV("DT","FM"),Y)=$P(^XTMP("ASUR","R74",0),U,2) X ^DD("DD") S ASUV("DT")=Y,ASUC("PG")=0,ASUC("LN")=0
S ASUX("SST")=0 F S ASUX("SST")=$O(^XTMP("ASUR","R74",ASUX("SST"))) Q:ASUX("SST")="" D Q:$D(DUOUT)
.S ASUA("SST")=$P(^XTMP("ASUR","R74",ASUX("SST")),U,3)
.S ASUX("SSA")="" F S ASUX("SSA")=$O(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA"))) Q:ASUX("SSA")="" Q:$D(DTOUT) Q:$D(DUOUT) D Q:$D(DUOUT)
..S ASUA("SSA")=$P(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA")),U,3)
..S ASUX("ACC")="",ASUF("SSA")=1
..F S ASUX("ACC")=$O(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA"),ASUX("ACC"))) Q:ASUX("ACC")="" Q:$D(DTOUT) Q:$D(DUOUT) D Q:$D(DUOUT)
...S ASUA=^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA"),ASUX("ACC"))
...D ACC^ASULDIRF(ASUX("ACC"))
...I ASUF("HDR")>0 D HEADER Q:$D(DUOUT)
...S ASUA("B")=$P(ASUA,U,2),ASUA("J")=$P(ASUA,U,3),ASUA("G")=ASUA("B")+ASUA("J"),ASUA("L")=$P(ASUA,U,4)
...S ASUA("M")=$P(ASUA,U,5),ASUA("Y")=$P(ASUA,U,6),ASUA("N")=$P(ASUA,U,7),ASUA("BAL")=ASUA("L")-(ASUA("Y")+ASUA("N"))
...S ASUA("V")=$E(ASUV("DT","FM"),4,5)+3 S:ASUA("V")>12 ASUA("V")=ASUA("V")-12
...S ASUA("P")=$FN(ASUA("G")-(((ASUA("Y")/ASUA("V"))*12)+ASUA("N")),"",2)
...S ASUA2=ASUA,$P(ASUA2,U)=ASUA("SST")
...I 'ASUF("RPT75") S:ASUF("SSA") ASUF("SSA")=0
...E D
....I ASUF("SSA") S ^XTMP("ASUR","R75",ASUX("SSA"))=ASUA("SSA"),ASUF("SSA")=0
....S ^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"))=ASUL(9,"ACC","NM")
....S ^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST"))=ASUA2
...S ASUC("LN")=ASUC("LN")+3 W !!," ACC ",ASUX("ACC") S ASUF("TOT")=0 D PRLINE
...W !," ",ASUL(9,"ACC","NM")
..Q:$D(DTOUT) Q:$D(DUOUT) S ASUF("HDR")=1,ASUF("TOT")=1 D PRTOTLL
.Q:$D(DTOUT) Q:$D(DUOUT) S ASUF("HDR")=1,ASUF("TOT")=2 D PRTOTL S ASUF("HDR")=1
.I ASUA("SST")="" S ASUV("SST")=ASUX("SST") D HEADER Q:$D(DUOUT)
I $D(DUOUT)!($D(DTOUT)) G END
S ASUF("TOT")=3 D PRTOTL
END ;
D PAZ^ASUURHDR I ASUK("PTRSEL")']"" D
.D C^ASUUZIS K ASUW
K ASUV,ASUF,ASUX,ASUF,ASUC,ASUA2,ASUT,ASURZ,ASURZA,ASURZW,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTUCI,DFOUT,DLOUT,DTOUT,DUOUT,X,X2,X3,Y
Q
P1 ;
F ASUU(11)=1:1:9 S ASUT=$P($T(CN+ASUU(11)),";",3) D
.F ASUU(12)=1:1:4 S ASURZ="ASUA("_ASUV("TOT")_","_ASUU(12)_","_ASUT_")",@ASURZ=0
Q
PRTOTLL ;EP;TOT
S ASUC("LN")=ASUC("LN")+1 W ! F ASUU(14)=1:1:9 S X=(ASUU(14)*12)+7 W ?X," -----------"
PRTOTL ;EP;TOT2
S ASUC("LN")=ASUC("LN")+2 W !,$P($T(TN+ASUF("TOT")),";",3) S:ASUF("TOT")=2 ASUF("HDR")=0 D PRLINE F ASUU(14)=1:1:9 S X=(ASUU(14)*12)+7 W ?X," ==========="
Q
PRLINE ;EP;DETAIL
F ASUU(11)=1:1:9 S ASUT=$P($T(CN+ASUU(11)),";",3) D
.S X=(ASUU(11)*12)+7,ASUU(13)=ASUF("TOT")+1,ASURZ="ASUA("_ASUT_")"
.S:ASUF("TOT")>0 ASURZ="ASUA("_ASUV("TOT")_","_ASUF("TOT")_","_ASUT_")"
.S ASURZA="ASUA("_ASUV("TOT")_","_ASUU(13)_","_ASUT_")"
.S ASURZW="W ?X,$J($FN("_ASURZ_","",+T"",0),12)"
.X ASURZW ;U IO(0) X ASURZW U ASUK("SRPT","IO")
.S @ASURZA=@ASURZA+@ASURZ,@ASURZ=0
F ASUU(14)=1:1:ASUF("TOT") W ! S ASUC("LN")=ASUC("LN")+1
Q
S ASUC("PG")=ASUC("PG")+1 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
W !,"REPORT #74 STORES STOCK ISSUES/BUDGET ANALYSIS BY LOCATION",?70,"AS OF: ",ASUV("DT"),?90,"PAGE:",$J(ASUC("PG"),3)
W !!,"SUB STATION: ",$G(ASUA("SST")),!!,"SUB-SUB ACTIVITY: ",$G(ASUA("SSA"))
W !!!?22,"ANNUAL",?34,"BUDGET",?46,"ADJUSTED",?58,"ALLOTMENT",?94,"NON-REC",?106,"CURRENT",?118,"PROJECTED"
W !?22," BASE",?34,"ADJUST",?46,"ANNUAL",?58,"TO",?70,"RECURRING",?82,"ISSUES",?94,"ISSUES",?106,"FUND",?118,"YEAR END"
W !,"ACCOUNT",?22,"BUDGET",?34,"+ OR -",?46,"BUDGET",?58,"DATE",?70,"CUR MO",?82,"Y-T-D",?94,"Y-T-D",?106,"BALANCE",?118,"BALANCE",!!
S ASUC("LN")=12,ASUF("HDR")=0
Q
CN ;
;;"B"
;;"J"
;;"G"
;;"L"
;;"M"
;;"Y"
;;"N"
;;"BAL"
;;"P"
TN ;;
;;SUB-SUB ACT TOTAL
;;SUB STATION TOTAL
;;AREA TOTAL
CMPT ;EP;SORT
K ^XTMP("ASUR","R74") S ^XTMP("ASUR","R74",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM"),ASUL(18,"SST","E#")=ASUL(1,"AR","AP")_"000"
F S ASUL(18,"SST","E#")=$O(^ASUL(18,ASUL(18,"SST","E#"))) D Q:ASUL(18,"SST","E#")']""
.I $E(ASUL(18,"SST","E#"),1,2)'=ASUL(1,"AR","AP") S ASUL(18,"SST","E#")="" Q
.D SST^ASULDIRR(ASUL(18,"SST","E#"))
.S ^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"))=ASUL(18,"SST","E#")
.S $P(^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#")),U,3)=ASUL(18,"SST")_" -"_ASUL(18,"SST","NM")
S ASUL(18,"SST","E#")=""
F ASUC=0:1 S ASUL(18,"SST","E#")=$O(^XTMP("ASUR","R74","ZB",ASUL(18,"SST","E#"))) Q:ASUL(18,"SST","E#")']"" D
.S ASUL(21,"SSA","E#")=0
.F ASUC(0)=0:1 S ASUL(21,"SSA","E#")=$O(^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#"))) Q:ASUL(21,"SSA","E#")'?1N.N D
..S ^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=ASUL(21,"SSA","E#")
..S X=$P(^ASUL(17,ASUL(21,"SSA","E#"),0),U) S:X="" X="N/F"
..S Y=$P(^ASUL(17,ASUL(21,"SSA","E#"),1),U) S:Y="" Y="N/F"
..S $P(^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#")),U,3)=Y_" -"_X
..S ASUL(21,"ACC","E#")=0
..F ASUC(1)=0:1 S ASUL(21,"ACC","E#")=$O(^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#"),1,ASUL(21,"ACC","E#"))) Q:ASUL(21,"ACC","E#")'?1N.N D
...S X=^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#"),1,ASUL(21,"ACC","E#"),0)
...S ASUC(3)=0 F ASUC(2)=2:1:6 S ASUC(3)=ASUC(3)+$P(X,U,ASUC(2))
...I ASUC(3)>0 S ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"),+ASUL(21,"ACC","E#"))=X
...E S ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"),+ASUL(21,"ACC","E#"))=X,ASUC(1)=ASUC(1)=1
..I ASUC(1)>0 S ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))
..E S ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#")),ASUC(0)=ASUC(0)-1
.I ASUC(0)>0 S ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"))
.E S ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#")),ASUC=ASUC-1
S ASUMY("E#","REQ")=0
F S ASUMY("E#","REQ")=$O(^ASUMY(ASUMY("E#","REQ"))) Q:ASUMY("E#","REQ")'?1N.N D
.S ASUMY("E#","SSA")=0
.F S ASUMY("E#","SSA")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"))) Q:ASUMY("E#","SSA")'?1N.N D
..S ASUMY("E#","ACC")=0
..F S ASUMY("E#","ACC")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"))) Q:ASUMY("E#","ACC")'?1N.N D
...D READ^ASUMYDIO
...I '$D(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))) D
....S X=$G(^XTMP("ASUR","R74","ZB",ASUMY("SST"),+ASUMY("SSA"),+ASUMY("ACC")))
....S:X="" X="^^^^^^^NO BUDG"
....S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))=X
...I $D(^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))) D
....S ASUX(0)=^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))
...E D
....S ASUX(0)=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))
...S (ASUC("SUM"),ASUF("BLD"))=0
...F ASUU(12)="5;RCR;CMO","6;RCR;YTD","7;NRC;YTD" D
....S ASUMY($P(ASUU(12),";",3),$P(ASUU(12),";",2),"VAL")=$FN(ASUMY($P(ASUU(12),";",3),$P(ASUU(12),";",2),"VAL"),"",0)
....S ASUC("SUM")=$P(ASUX(0),U,$P(ASUU(12),";"))+ASUMY($P(ASUU(12),";",3),$P(ASUU(12),";",2),"VAL")
....Q:ASUC("SUM")'>0
....I ASUF("BLD")=0 D BUILD2
....S $P(ASUX(0),U,$P(ASUU(12),";"))=ASUC("SUM"),ASUC("SUM")=0
...I 'ASUF("BLD") D
....F ASUU(12)=2:1:4 D Q:ASUF("BLD")
.....I $P(ASUX(0),U,ASUU(12))]"" D BUILD2
...I ASUF("BLD") S ^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))=ASUX(0)
...K X
K ASUX,ASUV,ASUMU,^XTMP("ASUR","R74","ZA"),^XTMP("ASUR","R74","ZB") F X=3:1:22 K ASUL(X)
Q
BUILD2 ;
S ASUF("BLD")=1
I '$D(^XTMP("ASUR","R74",ASUMY("E#","SST"))) D
.S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=$G(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST")))
.I ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))="" S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=$G(^XTMP("ASUR","R74","ZB",ASUMY("E#","SST")))
.I ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))="" S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))="^^^"_ASUMY("SST")_" -N/F"
.S ^XTMP("ASUR","R74",ASUMY("E#","SST"))=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))
I '$D(^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"))) D
.S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=$G(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA")))
.I ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="" S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=$G(^XTMP("ASUR","R74","ZB",ASUMY("E#","SST"),+ASUMY("SSA")))
.I ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="" D
..D SSA^ASULDIRR(ASUMY("SSA"))
..I Y>0 D
...S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="^^"_ASUL(17,"SSA")_" - "_ASUL(17,"SSA","NM")
..E D
...S ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="^^"_ASUMY("SSA")_"- N/F"
.S ^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"))=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))
Q
ASURM74P ; IHS/ITSC/LMH -ISS ANAL BY LOC ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;prints report 74, Stock Issues/Budget ;Analysis by Location Report.
EN ;EP;PRIME
+1 ;WAR 5/21/99
QUIT
+2 IF '$DATA(IO)
DO HOME^%ZIS
IF '$DATA(DUZ(2))
WRITE !,"Run from Kernel only"
QUIT
+3 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+4 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+5 SET ZTRTN="PSER^ASURM74P"
SET ZTDESC="SAMS RPT 74"
DO O^ASUUZIS
+6 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+7 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;TMQ
+1 SET ASUF("HDR")=1
SET X=$ORDER(^XTMP("ASUR","R74",""))
SET ASUF("RPT75")=+$GET(ASUF("RPT75"))
+2 IF ASUF("RPT75")
KILL ^XTMP("ASUR","R75")
SET ^XTMP("ASUR","R75",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+3 DO U^ASUUZIS
SET ASUV("TOT")="""TOT"""
DO P1
IF '$DATA(^XTMP("ASUR","R74"))
GOTO END
+4 SET (ASUV("DT","FM"),Y)=$PIECE(^XTMP("ASUR","R74",0),U,2)
XECUTE ^DD("DD")
SET ASUV("DT")=Y
SET ASUC("PG")=0
SET ASUC("LN")=0
+5 SET ASUX("SST")=0
FOR
SET ASUX("SST")=$ORDER(^XTMP("ASUR","R74",ASUX("SST")))
IF ASUX("SST")=""
QUIT
Begin DoDot:1
+6 SET ASUA("SST")=$PIECE(^XTMP("ASUR","R74",ASUX("SST")),U,3)
+7 SET ASUX("SSA")=""
FOR
SET ASUX("SSA")=$ORDER(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA")))
IF ASUX("SSA")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:2
+8 SET ASUA("SSA")=$PIECE(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA")),U,3)
+9 SET ASUX("ACC")=""
SET ASUF("SSA")=1
+10 FOR
SET ASUX("ACC")=$ORDER(^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA"),ASUX("ACC")))
IF ASUX("ACC")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:3
+11 SET ASUA=^XTMP("ASUR","R74",ASUX("SST"),ASUX("SSA"),ASUX("ACC"))
+12 DO ACC^ASULDIRF(ASUX("ACC"))
+13 IF ASUF("HDR")>0
DO HEADER
IF $DATA(DUOUT)
QUIT
+14 SET ASUA("B")=$PIECE(ASUA,U,2)
SET ASUA("J")=$PIECE(ASUA,U,3)
SET ASUA("G")=ASUA("B")+ASUA("J")
SET ASUA("L")=$PIECE(ASUA,U,4)
+15 SET ASUA("M")=$PIECE(ASUA,U,5)
SET ASUA("Y")=$PIECE(ASUA,U,6)
SET ASUA("N")=$PIECE(ASUA,U,7)
SET ASUA("BAL")=ASUA("L")-(ASUA("Y")+ASUA("N"))
+16 SET ASUA("V")=$EXTRACT(ASUV("DT","FM"),4,5)+3
IF ASUA("V")>12
SET ASUA("V")=ASUA("V")-12
+17 SET ASUA("P")=$FNUMBER(ASUA("G")-(((ASUA("Y")/ASUA("V"))*12)+ASUA("N")),"",2)
+18 SET ASUA2=ASUA
SET $PIECE(ASUA2,U)=ASUA("SST")
+19 IF 'ASUF("RPT75")
IF ASUF("SSA")
SET ASUF("SSA")=0
+20 IF '$TEST
Begin DoDot:4
+21 IF ASUF("SSA")
SET ^XTMP("ASUR","R75",ASUX("SSA"))=ASUA("SSA")
SET ASUF("SSA")=0
+22 SET ^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"))=ASUL(9,"ACC","NM")
+23 SET ^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST"))=ASUA2
End DoDot:4
+24 SET ASUC("LN")=ASUC("LN")+3
WRITE !!," ACC ",ASUX("ACC")
SET ASUF("TOT")=0
DO PRLINE
+25 WRITE !," ",ASUL(9,"ACC","NM")
End DoDot:3
IF $DATA(DUOUT)
QUIT
+26 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
SET ASUF("HDR")=1
SET ASUF("TOT")=1
DO PRTOTLL
End DoDot:2
IF $DATA(DUOUT)
QUIT
+27 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
SET ASUF("HDR")=1
SET ASUF("TOT")=2
DO PRTOTL
SET ASUF("HDR")=1
+28 IF ASUA("SST")=""
SET ASUV("SST")=ASUX("SST")
DO HEADER
IF $DATA(DUOUT)
QUIT
End DoDot:1
IF $DATA(DUOUT)
QUIT
+29 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO END
+30 SET ASUF("TOT")=3
DO PRTOTL
END ;
+1 DO PAZ^ASUURHDR
IF ASUK("PTRSEL")']""
Begin DoDot:1
+2 DO C^ASUUZIS
KILL ASUW
End DoDot:1
+3 KILL ASUV,ASUF,ASUX,ASUF,ASUC,ASUA2,ASUT,ASURZ,ASURZA,ASURZW,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTUCI,DFOUT,DLOUT,DTOUT,DUOUT,X,X2,X3,Y
+4 QUIT
P1 ;
+1 FOR ASUU(11)=1:1:9
SET ASUT=$PIECE($TEXT(CN+ASUU(11)),";",3)
Begin DoDot:1
+2 FOR ASUU(12)=1:1:4
SET ASURZ="ASUA("_ASUV("TOT")_","_ASUU(12)_","_ASUT_")"
SET @ASURZ=0
End DoDot:1
+3 QUIT
PRTOTLL ;EP;TOT
+1 SET ASUC("LN")=ASUC("LN")+1
WRITE !
FOR ASUU(14)=1:1:9
SET X=(ASUU(14)*12)+7
WRITE ?X," -----------"
PRTOTL ;EP;TOT2
+1 SET ASUC("LN")=ASUC("LN")+2
WRITE !,$PIECE($TEXT(TN+ASUF("TOT")),";",3)
IF ASUF("TOT")=2
SET ASUF("HDR")=0
DO PRLINE
FOR ASUU(14)=1:1:9
SET X=(ASUU(14)*12)+7
WRITE ?X," ==========="
+2 QUIT
PRLINE ;EP;DETAIL
+1 FOR ASUU(11)=1:1:9
SET ASUT=$PIECE($TEXT(CN+ASUU(11)),";",3)
Begin DoDot:1
+2 SET X=(ASUU(11)*12)+7
SET ASUU(13)=ASUF("TOT")+1
SET ASURZ="ASUA("_ASUT_")"
+3 IF ASUF("TOT")>0
SET ASURZ="ASUA("_ASUV("TOT")_","_ASUF("TOT")_","_ASUT_")"
+4 SET ASURZA="ASUA("_ASUV("TOT")_","_ASUU(13)_","_ASUT_")"
+5 SET ASURZW="W ?X,$J($FN("_ASURZ_","",+T"",0),12)"
+6 ;U IO(0) X ASURZW U ASUK("SRPT","IO")
XECUTE ASURZW
+7 SET @ASURZA=@ASURZA+@ASURZ
SET @ASURZ=0
End DoDot:1
+8 FOR ASUU(14)=1:1:ASUF("TOT")
WRITE !
SET ASUC("LN")=ASUC("LN")+1
+9 QUIT
+1 SET ASUC("PG")=ASUC("PG")+1
IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+2 WRITE !,"REPORT #74 STORES STOCK ISSUES/BUDGET ANALYSIS BY LOCATION",?70,"AS OF: ",ASUV("DT"),?90,"PAGE:",$JUSTIFY(ASUC("PG"),3)
+3 WRITE !!,"SUB STATION: ",$GET(ASUA("SST")),!!,"SUB-SUB ACTIVITY: ",$GET(ASUA("SSA"))
+4 WRITE !!!?22,"ANNUAL",?34,"BUDGET",?46,"ADJUSTED",?58,"ALLOTMENT",?94,"NON-REC",?106,"CURRENT",?118,"PROJECTED"
+5 WRITE !?22," BASE",?34,"ADJUST",?46,"ANNUAL",?58,"TO",?70,"RECURRING",?82,"ISSUES",?94,"ISSUES",?106,"FUND",?118,"YEAR END"
+6 WRITE !,"ACCOUNT",?22,"BUDGET",?34,"+ OR -",?46,"BUDGET",?58,"DATE",?70,"CUR MO",?82,"Y-T-D",?94,"Y-T-D",?106,"BALANCE",?118,"BALANCE",!!
+7 SET ASUC("LN")=12
SET ASUF("HDR")=0
+8 QUIT
CN ;
+1 ;;"B"
+2 ;;"J"
+3 ;;"G"
+4 ;;"L"
+5 ;;"M"
+6 ;;"Y"
+7 ;;"N"
+8 ;;"BAL"
+9 ;;"P"
TN ;;
+1 ;;SUB-SUB ACT TOTAL
+2 ;;SUB STATION TOTAL
+3 ;;AREA TOTAL
CMPT ;EP;SORT
+1 KILL ^XTMP("ASUR","R74")
SET ^XTMP("ASUR","R74",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
SET ASUL(18,"SST","E#")=ASUL(1,"AR","AP")_"000"
+2 FOR
SET ASUL(18,"SST","E#")=$ORDER(^ASUL(18,ASUL(18,"SST","E#")))
Begin DoDot:1
+3 IF $EXTRACT(ASUL(18,"SST","E#"),1,2)'=ASUL(1,"AR","AP")
SET ASUL(18,"SST","E#")=""
QUIT
+4 DO SST^ASULDIRR(ASUL(18,"SST","E#"))
+5 SET ^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"))=ASUL(18,"SST","E#")
+6 SET $PIECE(^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#")),U,3)=ASUL(18,"SST")_" -"_ASUL(18,"SST","NM")
End DoDot:1
IF ASUL(18,"SST","E#")']""
QUIT
+7 SET ASUL(18,"SST","E#")=""
+8 FOR ASUC=0:1
SET ASUL(18,"SST","E#")=$ORDER(^XTMP("ASUR","R74","ZB",ASUL(18,"SST","E#")))
IF ASUL(18,"SST","E#")']""
QUIT
Begin DoDot:1
+9 SET ASUL(21,"SSA","E#")=0
+10 FOR ASUC(0)=0:1
SET ASUL(21,"SSA","E#")=$ORDER(^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#")))
IF ASUL(21,"SSA","E#")'?1N.N
QUIT
Begin DoDot:2
+11 SET ^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=ASUL(21,"SSA","E#")
+12 SET X=$PIECE(^ASUL(17,ASUL(21,"SSA","E#"),0),U)
IF X=""
SET X="N/F"
+13 SET Y=$PIECE(^ASUL(17,ASUL(21,"SSA","E#"),1),U)
IF Y=""
SET Y="N/F"
+14 SET $PIECE(^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#")),U,3)=Y_" -"_X
+15 SET ASUL(21,"ACC","E#")=0
+16 FOR ASUC(1)=0:1
SET ASUL(21,"ACC","E#")=$ORDER(^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#"),1,ASUL(21,"ACC","E#")))
IF ASUL(21,"ACC","E#")'?1N.N
QUIT
Begin DoDot:3
+17 SET X=^ASUL(21,ASUL(18,"SST","E#"),1,ASUL(21,"SSA","E#"),1,ASUL(21,"ACC","E#"),0)
+18 SET ASUC(3)=0
FOR ASUC(2)=2:1:6
SET ASUC(3)=ASUC(3)+$PIECE(X,U,ASUC(2))
+19 IF ASUC(3)>0
SET ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"),+ASUL(21,"ACC","E#"))=X
+20 IF '$TEST
SET ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"),+ASUL(21,"ACC","E#"))=X
SET ASUC(1)=ASUC(1)=1
End DoDot:3
+21 IF ASUC(1)>0
SET ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))
+22 IF '$TEST
SET ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"),+ASUL(21,"SSA","E#"))
SET ASUC(0)=ASUC(0)-1
End DoDot:2
+23 IF ASUC(0)>0
SET ^XTMP("ASUR","R74",+ASUL(18,"SST","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"))
+24 IF '$TEST
SET ^XTMP("ASUR","R74","ZA",+ASUL(18,"SST","E#"))=^XTMP("ASUR","R74","ZB",+ASUL(18,"SST","E#"))
SET ASUC=ASUC-1
End DoDot:1
+25 SET ASUMY("E#","REQ")=0
+26 FOR
SET ASUMY("E#","REQ")=$ORDER(^ASUMY(ASUMY("E#","REQ")))
IF ASUMY("E#","REQ")'?1N.N
QUIT
Begin DoDot:1
+27 SET ASUMY("E#","SSA")=0
+28 FOR
SET ASUMY("E#","SSA")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA")))
IF ASUMY("E#","SSA")'?1N.N
QUIT
Begin DoDot:2
+29 SET ASUMY("E#","ACC")=0
+30 FOR
SET ASUMY("E#","ACC")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC")))
IF ASUMY("E#","ACC")'?1N.N
QUIT
Begin DoDot:3
+31 DO READ^ASUMYDIO
+32 IF '$DATA(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC")))
Begin DoDot:4
+33 SET X=$GET(^XTMP("ASUR","R74","ZB",ASUMY("SST"),+ASUMY("SSA"),+ASUMY("ACC")))
+34 IF X=""
SET X="^^^^^^^NO BUDG"
+35 SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))=X
End DoDot:4
+36 IF $DATA(^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC")))
Begin DoDot:4
+37 SET ASUX(0)=^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))
End DoDot:4
+38 IF '$TEST
Begin DoDot:4
+39 SET ASUX(0)=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))
End DoDot:4
+40 SET (ASUC("SUM"),ASUF("BLD"))=0
+41 FOR ASUU(12)="5;RCR;CMO","6;RCR;YTD","7;NRC;YTD"
Begin DoDot:4
+42 SET ASUMY($PIECE(ASUU(12),";",3),$PIECE(ASUU(12),";",2),"VAL")=$FNUMBER(ASUMY($PIECE(ASUU(12),";",3),$PIECE(ASUU(12),";",2),"VAL"),"",0)
+43 SET ASUC("SUM")=$PIECE(ASUX(0),U,$PIECE(ASUU(12),";"))+ASUMY($PIECE(ASUU(12),";",3),$PIECE(ASUU(12),";",2),"VAL")
+44 IF ASUC("SUM")'>0
QUIT
+45 IF ASUF("BLD")=0
DO BUILD2
+46 SET $PIECE(ASUX(0),U,$PIECE(ASUU(12),";"))=ASUC("SUM")
SET ASUC("SUM")=0
End DoDot:4
+47 IF 'ASUF("BLD")
Begin DoDot:4
+48 FOR ASUU(12)=2:1:4
Begin DoDot:5
+49 IF $PIECE(ASUX(0),U,ASUU(12))]""
DO BUILD2
End DoDot:5
IF ASUF("BLD")
QUIT
End DoDot:4
+50 IF ASUF("BLD")
SET ^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"),+ASUMY("ACC"))=ASUX(0)
+51 KILL X
End DoDot:3
End DoDot:2
End DoDot:1
+52 KILL ASUX,ASUV,ASUMU,^XTMP("ASUR","R74","ZA"),^XTMP("ASUR","R74","ZB")
FOR X=3:1:22
KILL ASUL(X)
+53 QUIT
BUILD2 ;
+1 SET ASUF("BLD")=1
+2 IF '$DATA(^XTMP("ASUR","R74",ASUMY("E#","SST")))
Begin DoDot:1
+3 SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=$GET(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST")))
+4 IF ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=""
SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=$GET(^XTMP("ASUR","R74","ZB",ASUMY("E#","SST")))
+5 IF ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))=""
SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))="^^^"_ASUMY("SST")_" -N/F"
+6 SET ^XTMP("ASUR","R74",ASUMY("E#","SST"))=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"))
End DoDot:1
+7 IF '$DATA(^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA")))
Begin DoDot:1
+8 SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=$GET(^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA")))
+9 IF ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=""
SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=$GET(^XTMP("ASUR","R74","ZB",ASUMY("E#","SST"),+ASUMY("SSA")))
+10 IF ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))=""
Begin DoDot:2
+11 DO SSA^ASULDIRR(ASUMY("SSA"))
+12 IF Y>0
Begin DoDot:3
+13 SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="^^"_ASUL(17,"SSA")_" - "_ASUL(17,"SSA","NM")
End DoDot:3
+14 IF '$TEST
Begin DoDot:3
+15 SET ^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))="^^"_ASUMY("SSA")_"- N/F"
End DoDot:3
End DoDot:2
+16 SET ^XTMP("ASUR","R74",ASUMY("E#","SST"),+ASUMY("SSA"))=^XTMP("ASUR","R74","ZA",ASUMY("E#","SST"),+ASUMY("SSA"))
End DoDot:1
+17 QUIT
