- 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
