ASURM75P ; IHS/ITSC/LMH -STOCK ISSUES/BUDGET ANAL SUMMARY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 75, Stock Issues / Budget
;Analysis Summary Report.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 75
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^ASURM75P",ZTDESC="SAMS RPT 75" 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 ASUF("HDR")=1
S ASUC("LN")=0
S X=$O(^XTMP("ASUR","R75",0))
I X']"" D CLS^ASUUHDG W !!,"NO DATA FOR REPORT 75" G K
S ASUV("TOT")="""TOT"""
F ASUU(11)=1:1:9 S ASUT=$P($T(COLNAM+ASUU(11)),";",3) D
.F ASUU(12)=1:1:4 S ASURZ="ASUA("_ASUV("TOT")_","_ASUU(12)_","_ASUT_")",@ASURZ=0
S (ASUV("DT","FM"),Y)=$P(^XTMP("ASUR","R74",0),U,2) X ^DD("DD") S ASUV("DT")=Y,ASUC("PG")=0
S ASUX("SSA")=0
F S ASUX("SSA")=$O(^XTMP("ASUR","R75",ASUX("SSA"))) Q:ASUX("SSA")="" Q:$D(DTOUT) D Q:$D(DUOUT)
.S ASUA("SSA")=^XTMP("ASUR","R75",ASUX("SSA"))
.S ASUX("ACC")="",ASUF("ACC")=0
.F S ASUX("ACC")=$O(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"))) Q:ASUX("ACC")="" Q:$D(DTOUT) D Q:$D(DUOUT)
..S ASUX("SST")=""
..S ASUF("ACC")=1
..S ASUK("ACC","NM")=^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"))
..F S ASUX("SST")=$O(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST"))) Q:ASUX("SST")="" Q:$D(DTOUT) D
...S ASUA("SST")=$P($P(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST")),U)," -",2)
...S ASULA=^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST"))
...S ASUA("BASE")=$P(ASULA,U,2)
...S ASUA("ADJS")=$P(ASULA,U,3)
...S ASUA("BUDG")=ASUA("BASE")+ASUA("ADJS")
...S ASUA("ALOT")=$P(ASULA,U,4)
...S ASUA("YTD")=$P(ASULA,U,6)
...S ASUA("NOR")=$P(ASULA,U,7)
...S ASUA("TYTD")=ASUA("YTD")+ASUA("NOR")
...S ASUA("BAL")=ASUA("ALOT")-(ASUA("YTD")+ASUA("NOR"))
...I ASUA("BUDG")=0,ASUA("BAL")=0 D
....S ASUA("PROJ")=0
...E D Q:$D(DUOUT)
....S ASUA("DIV")=$E(ASUV("DT","FM"),4,5)+3 S:ASUA("DIV")>12 ASUA("DIV")=ASUA("DIV")-12
....S ASUA("PROJ")=ASUA("BUDG")-(((ASUA("YTD")/ASUA("DIV"))*12)+ASUA("NOR"))
...S ASUC("LN")=ASUC("LN")+1 S:ASUC("LN")>58 ASUF("HDR")=1
...D:ASUF("HDR") HEADER Q:$D(DUOUT)
...I ASUF("ACC") W !," ACC ",ASUX("ACC")
...W ?18,ASUA("SST")
...S ASUF("TOT")=0 D PRLINE
...I ASUF("ACC") W !," ",ASUK("ACC","NM") S ASUF("ACC")=0 Q
...W !
..Q:$D(DTOUT)
..S ASUF("TOT")=1 D
...S ASUC("LN")=ASUC("LN")+1
...F ASUU(14)=1:1:7 S X=(ASUU(14)*12)+27 W ?X," -----------"
...W !,ASUK("ACC","NM")," " D PRTOTL
.Q:$D(DTOUT)
.S ASUF("TOT")=2 W !,ASUA("SSA")," " D PRTOTL
.S ASUF("HDR")=1
G:$D(DTOUT)!('ASUF("HDR")) K
S ASUF("TOT")=3 W ! D PRTOTL
K ;
K ASUU(11),ASUU(12),ASUU(13),ASUU(14),ASUC,ASUF,ASULA,ASUT,ASUV,ASUX,ASURZ,ASURZA,ASURZW
K DFOUT,DLOUT,DTOUT,DUOUT
K X,X2,X3,Y
D PAZ^ASUURHDR
I ASUK("PTRSEL")]"" W @IOF Q
D C^ASUUZIS
Q
PRTOTL ;
S ASUC("LN")=ASUC("LN")+2
W $P($T(TOTNAM+ASUF("TOT")),";",3)
D PRLINE
W !
F ASUU(14)=1:1:7 S X=(ASUU(14)*12)+27 W ?X," ==========="
Q
PRLINE ;
F ASUU(11)=1:1:7 S ASUT=$P($T(COLNAM+ASUU(11)),";",3) D
.S X=(ASUU(11)*12)+27,ASUU(13)=ASUF("TOT")+1
.S 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
.S @ASURZA=@ASURZA+@ASURZ,@ASURZ=0
I ASUF("TOT")=0!(ASUF("TOT")=3) Q
W ! S ASUC("LN")=ASUC("LN")+1
I ASUF("TOT")=2 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 #75 SUMMARY OF STORES STOCK ISSUES/BUDGET ANALYSIS",?65,"AS OF: ",ASUV("DT"),?99,"PAGE:",$J(ASUC("PG"),3)
W !!,"SUB-SUB ACTIVITY: ",ASUA("SSA")
W !!!?43,"ANNUAL",?55,"BUDGET",?67,"ADJUSTED",?79,"ALLOTMENT",?91,"TOTAL",?103,"CURRENT",?115,"PROJECTED"
W !?43,"BASE",?55,"ADJUST",?67,"ANNUAL",?79,"TO",?91,"ISSUES",?103,"FUND",?115,"YEAR END"
W !,"ACCOUNT",?20,"LOCATION",?43,"BUDGET",?55,"+ OR -",?67,"BUDGET",?79,"DATE",?91,"Y-T-D",?103,"BALANCE",?115,"BALANCE",!!
S ASUC("LN")=11,ASUF("HDR")=0,ASUF("ACC")=1
Q
COLNAM ;
;;"BASE"
;;"ADJS"
;;"BUDG"
;;"ALOT"
;;"TYTD"
;;"BAL"
;;"PROJ"
;;"CMO"
;;"YTD"
;;"NOR"
TOTNAM ;;
;;ACC TOT
;;SSA TOT
;;AREA TOT
ASURM75P ; IHS/ITSC/LMH -STOCK ISSUES/BUDGET ANAL SUMMARY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 75, Stock Issues / Budget
+3 ;Analysis Summary Report.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 75
+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^ASURM75P"
SET ZTDESC="SAMS RPT 75"
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 ASUF("HDR")=1
+3 SET ASUC("LN")=0
+4 SET X=$ORDER(^XTMP("ASUR","R75",0))
+5 IF X']""
DO CLS^ASUUHDG
WRITE !!,"NO DATA FOR REPORT 75"
GOTO K
+6 SET ASUV("TOT")="""TOT"""
+7 FOR ASUU(11)=1:1:9
SET ASUT=$PIECE($TEXT(COLNAM+ASUU(11)),";",3)
Begin DoDot:1
+8 FOR ASUU(12)=1:1:4
SET ASURZ="ASUA("_ASUV("TOT")_","_ASUU(12)_","_ASUT_")"
SET @ASURZ=0
End DoDot:1
+9 SET (ASUV("DT","FM"),Y)=$PIECE(^XTMP("ASUR","R74",0),U,2)
XECUTE ^DD("DD")
SET ASUV("DT")=Y
SET ASUC("PG")=0
+10 SET ASUX("SSA")=0
+11 FOR
SET ASUX("SSA")=$ORDER(^XTMP("ASUR","R75",ASUX("SSA")))
IF ASUX("SSA")=""
QUIT
IF $DATA(DTOUT)
QUIT
Begin DoDot:1
+12 SET ASUA("SSA")=^XTMP("ASUR","R75",ASUX("SSA"))
+13 SET ASUX("ACC")=""
SET ASUF("ACC")=0
+14 FOR
SET ASUX("ACC")=$ORDER(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC")))
IF ASUX("ACC")=""
QUIT
IF $DATA(DTOUT)
QUIT
Begin DoDot:2
+15 SET ASUX("SST")=""
+16 SET ASUF("ACC")=1
+17 SET ASUK("ACC","NM")=^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"))
+18 FOR
SET ASUX("SST")=$ORDER(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST")))
IF ASUX("SST")=""
QUIT
IF $DATA(DTOUT)
QUIT
Begin DoDot:3
+19 SET ASUA("SST")=$PIECE($PIECE(^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST")),U)," -",2)
+20 SET ASULA=^XTMP("ASUR","R75",ASUX("SSA"),ASUX("ACC"),ASUX("SST"))
+21 SET ASUA("BASE")=$PIECE(ASULA,U,2)
+22 SET ASUA("ADJS")=$PIECE(ASULA,U,3)
+23 SET ASUA("BUDG")=ASUA("BASE")+ASUA("ADJS")
+24 SET ASUA("ALOT")=$PIECE(ASULA,U,4)
+25 SET ASUA("YTD")=$PIECE(ASULA,U,6)
+26 SET ASUA("NOR")=$PIECE(ASULA,U,7)
+27 SET ASUA("TYTD")=ASUA("YTD")+ASUA("NOR")
+28 SET ASUA("BAL")=ASUA("ALOT")-(ASUA("YTD")+ASUA("NOR"))
+29 IF ASUA("BUDG")=0
IF ASUA("BAL")=0
Begin DoDot:4
+30 SET ASUA("PROJ")=0
End DoDot:4
+31 IF '$TEST
Begin DoDot:4
+32 SET ASUA("DIV")=$EXTRACT(ASUV("DT","FM"),4,5)+3
IF ASUA("DIV")>12
SET ASUA("DIV")=ASUA("DIV")-12
+33 SET ASUA("PROJ")=ASUA("BUDG")-(((ASUA("YTD")/ASUA("DIV"))*12)+ASUA("NOR"))
End DoDot:4
IF $DATA(DUOUT)
QUIT
+34 SET ASUC("LN")=ASUC("LN")+1
IF ASUC("LN")>58
SET ASUF("HDR")=1
+35 IF ASUF("HDR")
DO HEADER
IF $DATA(DUOUT)
QUIT
+36 IF ASUF("ACC")
WRITE !," ACC ",ASUX("ACC")
+37 WRITE ?18,ASUA("SST")
+38 SET ASUF("TOT")=0
DO PRLINE
+39 IF ASUF("ACC")
WRITE !," ",ASUK("ACC","NM")
SET ASUF("ACC")=0
QUIT
+40 WRITE !
End DoDot:3
+41 IF $DATA(DTOUT)
QUIT
+42 SET ASUF("TOT")=1
Begin DoDot:3
+43 SET ASUC("LN")=ASUC("LN")+1
+44 FOR ASUU(14)=1:1:7
SET X=(ASUU(14)*12)+27
WRITE ?X," -----------"
+45 WRITE !,ASUK("ACC","NM")," "
DO PRTOTL
End DoDot:3
End DoDot:2
IF $DATA(DUOUT)
QUIT
+46 IF $DATA(DTOUT)
QUIT
+47 SET ASUF("TOT")=2
WRITE !,ASUA("SSA")," "
DO PRTOTL
+48 SET ASUF("HDR")=1
End DoDot:1
IF $DATA(DUOUT)
QUIT
+49 IF $DATA(DTOUT)!('ASUF("HDR"))
GOTO K
+50 SET ASUF("TOT")=3
WRITE !
DO PRTOTL
K ;
+1 KILL ASUU(11),ASUU(12),ASUU(13),ASUU(14),ASUC,ASUF,ASULA,ASUT,ASUV,ASUX,ASURZ,ASURZA,ASURZW
+2 KILL DFOUT,DLOUT,DTOUT,DUOUT
+3 KILL X,X2,X3,Y
+4 DO PAZ^ASUURHDR
+5 IF ASUK("PTRSEL")]""
WRITE @IOF
QUIT
+6 DO C^ASUUZIS
+7 QUIT
PRTOTL ;
+1 SET ASUC("LN")=ASUC("LN")+2
+2 WRITE $PIECE($TEXT(TOTNAM+ASUF("TOT")),";",3)
+3 DO PRLINE
+4 WRITE !
+5 FOR ASUU(14)=1:1:7
SET X=(ASUU(14)*12)+27
WRITE ?X," ==========="
+6 QUIT
PRLINE ;
+1 FOR ASUU(11)=1:1:7
SET ASUT=$PIECE($TEXT(COLNAM+ASUU(11)),";",3)
Begin DoDot:1
+2 SET X=(ASUU(11)*12)+27
SET ASUU(13)=ASUF("TOT")+1
+3 SET ASURZ="ASUA("_ASUT_")"
+4 IF ASUF("TOT")>0
SET ASURZ="ASUA("_ASUV("TOT")_","_ASUF("TOT")_","_ASUT_")"
+5 SET ASURZA="ASUA("_ASUV("TOT")_","_ASUU(13)_","_ASUT_")"
+6 SET ASURZW="W ?X,$J($FN("_ASURZ_","",+T"",0),12)"
+7 XECUTE ASURZW
+8 SET @ASURZA=@ASURZA+@ASURZ
SET @ASURZ=0
End DoDot:1
+9 IF ASUF("TOT")=0!(ASUF("TOT")=3)
QUIT
+10 WRITE !
SET ASUC("LN")=ASUC("LN")+1
+11 IF ASUF("TOT")=2
WRITE !
SET ASUC("LN")=ASUC("LN")+1
+12 QUIT
+1 SET ASUC("PG")=ASUC("PG")+1
IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+2 WRITE !,"REPORT #75 SUMMARY OF STORES STOCK ISSUES/BUDGET ANALYSIS",?65,"AS OF: ",ASUV("DT"),?99,"PAGE:",$JUSTIFY(ASUC("PG"),3)
+3 WRITE !!,"SUB-SUB ACTIVITY: ",ASUA("SSA")
+4 WRITE !!!?43,"ANNUAL",?55,"BUDGET",?67,"ADJUSTED",?79,"ALLOTMENT",?91,"TOTAL",?103,"CURRENT",?115,"PROJECTED"
+5 WRITE !?43,"BASE",?55,"ADJUST",?67,"ANNUAL",?79,"TO",?91,"ISSUES",?103,"FUND",?115,"YEAR END"
+6 WRITE !,"ACCOUNT",?20,"LOCATION",?43,"BUDGET",?55,"+ OR -",?67,"BUDGET",?79,"DATE",?91,"Y-T-D",?103,"BALANCE",?115,"BALANCE",!!
+7 SET ASUC("LN")=11
SET ASUF("HDR")=0
SET ASUF("ACC")=1
+8 QUIT
COLNAM ;
+1 ;;"BASE"
+2 ;;"ADJS"
+3 ;;"BUDG"
+4 ;;"ALOT"
+5 ;;"TYTD"
+6 ;;"BAL"
+7 ;;"PROJ"
+8 ;;"CMO"
+9 ;;"YTD"
+10 ;;"NOR"
TOTNAM ;;
+1 ;;ACC TOT
+2 ;;SSA TOT
+3 ;;AREA TOT
