- ASUMCUPD ; IHS/ITSC/LMH -CONTROL SHEET UPDATE ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine initializes Control Sheet Master for Fiscal Year Month
- S:$G(ASUMC(ASUMS("E#","STA"),0))']"" ^ASUMC(ASUMS("E#","STA"),0)=ASUMS("E#","STA")
- K ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"))
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),0)=ASUK("DT","FYM#")
- S:$G(ASUMC(ASUMS("E#","STA"),1,0))']"" ^ASUMC(ASUMS("E#","STA"),1,0)="^9002037.01^^"
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,0)="^9002037.11PA^^"
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,0)="^9002037.12PA^^"
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,0)="^9002037.13PA^^"
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,0)="^9002037.14PA^^"
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,0)="^9002037.15PA^^"
- ;All control sheet data blank for fiscal year month
- S ASURX="W !?3,""Getting Month's Master Beginning Balances""" D ^ASUUPLOG
- S ASUMS("E#","STA")=ASUL(2,"STA","E#")
- D:$G(ASUN("TYP"))']"" RANGE^ASUURANG(2)
- D LOAD^ASUCOHKP(.ASUN)
- N X,Y,Z
- F X=1:1:5,9 D
- .I '$D(^TMP("ASUMC",$J,X)) D Q
- ..S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
- .S Y=0 F S Y=$O(^TMP("ASUMC",$J,X,Y)) Q:Y']"" D
- ..S:$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0))']"" ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
- ..S Z=$G(Z)+$P(^TMP("ASUMC",$J,X,Y),U)
- .S $P(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0),U,2)=Z K Z
- F S ASUN("KEY")=$O(^ASUH("B",ASUN("KEY"))) Q:ASUN("KEY")']"" Q:ASUN("KEY")>ASUN("EKY") D
- .S ASUA=$O(^ASUH("B",ASUN("KEY"),""))
- .N Y D READ^ASU0TRRD(.ASUA,"H") Q:Y<0 ;Read history record
- .D RPT1,ACC,VOU,SCAN,DCAN,TRN
- CLOSE ;
- F X=1:1:5,9 D
- .S Z=^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)
- .S Y=$P(Z,U,2) ;W !?10,"OPEN : ",?20,Y
- .S Y=Y+$P(Z,U,3) ;W !,"+REC: ",$P(Z,U,3)," = ",?20,Y
- .S Y=Y+$P(Z,U,4) ;W !,"+TFI: ",$P(Z,U,4)," = ",?20,Y
- .S Y=Y+$P(Z,U,5) ;W !,"+PVR: ",$P(Z,U,5)," = ",?20,Y
- .S Y=Y+$P(Z,U,6) ;W !,"-SKI: ",$P(Z,U,6)," = ",?20,Y
- .S Y=Y+$P(Z,U,7) ;W !,"-TFO: ",$P(Z,U,7)," = ",?20,Y
- .S Y=Y+$P(Z,U,8) ;W !,"+PVI: ",$P(Z,U,8)," = ",?20,Y
- .S Y=Y+$P(Z,U,9) ;W !,"+-ADJ: ",$P(Z,U,9)," = ",?20,Y
- .S $P(Z,U,10)=Y
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=Z
- D RPT1YTD
- S DIK="^ASUMC(" D IXALL^DIK
- Q
- RPT1 ;Collect data for report 1
- CURMO ;Count transactions for report 1 - current month -subscript (2)
- S X=$G(^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#")))
- I X']"" S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- S $P(X,U,2)=$P(X,U,2)+1
- S ^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#"))=X
- TODAY ;Get active items (transactions posted today) beginning balances
- I $P(ASUN("KEY"),"-",2)=ASUK("DT","RUN") D
- .;Count transactions for report 1 - processed today -subscript (1)
- .S X=$G(^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#")))
- .I X']"" S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- .S $P(X,U,2)=$P(X,U,2)+1
- .S ^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#"))=X
- Q
- RPT1YTD ; Collect year to date item counts for report 1 - subscript (3)
- ;M ^XTMP("ASUR","R01",3)=^XTMP("ASUR","R01",2) ;Start with current month
- N W,X,Y,Z S Z=ASUK("DT","FYM#") F Z=Z:-1:1 D
- .S Y=0 F S Y=$O(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y)) Q:Y'?1N.N D
- ..S X=$G(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)),W=$G(^XTMP("ASUR","R01",3,Y)),$P(W,U)=Y,$P(W,U,2)=$P(W,U,2)+$P(X,U,2),^XTMP("ASUR","R01",3,Y)=W
- Q
- YEARCLR ;EP ;YEARLY CLEAR SUBSCRIPT 3
- N W,X,Y,Z S Z=ASUK("DT","FYM#") F Z=Z:-1:1 D
- .S Y=0 F S Y=$O(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y)) Q:Y'?1N.N D
- ..S ^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)=""
- Q
- ACC ;Accumulate value from transactions
- S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)),Z=ASUL(11,"TRN","TYPE")
- S:X']"" X=ASUT(ASUT,"ACC")_U
- S Y=$S(Z=2:3,Z=8:4,Z=3:6,Z=9:7,Z=6:9,Z=0:11,1:Z)
- Q:Z=1
- I Z=2,$E(ASUT("TRCD"),2)="0" S Y=5
- I Z=3,$E(ASUT("TRCD"),2)="0" S Y=8
- S $P(X,U,Y)=$P(X,U,Y)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)=X
- Q
- VOU ;Accumulate Values by Vouchers
- Q:$G(ASUT(ASUT,"VOU"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
- N X,Z
- S ASUW("E#","VOU")=($P(ASUT(ASUT,"VOU"),"-"))_($P(ASUT(ASUT,"VOU"),"-",2))_($P(ASUT(ASUT,"VOU"),"-",3))
- S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
- I Z="" D
- .S Z=ASUT(ASUT,"VOU")_U
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
- I $P(Z,U)'=ASUT(ASUT,"VOU") D
- .S ASUW("E#","VOU")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),""))
- .I ASUW("E#","VOU")']"" D
- ..S ASUW("E#","VOU")=($P(ASUT(ASUT,"VOU"),"-"))_(($P(ASUT(ASUT,"VOU"),"-",2))_($P(ASUT(ASUT,"VOU"),"-",3)))
- ..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
- ..I Z="" D
- ...S Z=ASUT(ASUT,"VOU")_U
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
- ..I $P(Z,U)'=ASUT(ASUT,"VOU") D
- ...S Y=-1 Q
- Q:Y<0
- S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0))
- I X="" S X=ASUT(ASUT,"ACC")_U_0
- S $P(X,U,2)=$P(X,U,2)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0)=X
- Q
- SCAN ;Accumulate Values by Stock Issue Cans
- Q:ASUL(11,"TRN","TYPE")'=3 Q:$G(ASUT(ASUT,"CAN"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
- N X,Z
- S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2))
- I ASUW("E#","CAN")'?1N.N S ASUW("E#","CAN")=1
- S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- I Z="" D
- .S Z=ASUT(ASUT,"CAN")_U
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- I $P(Z,U)'=ASUT(ASUT,"CAN") D
- .S ASUW("E#","CAN")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),""))
- .I ASUW("E#","CAN")']"" D
- ..S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),"J",2)) I (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0) S Y=-1 Q
- ..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- ..I Z="" D
- ...S Z=ASUT(ASUT,"CAN")_U
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- ..I $P(Z,U)'=ASUT(ASUT,"CAN") D
- ...S Y=-1 Q
- S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
- I X="" S X=ASUT(ASUT,"ACC")_U_0
- Q:Y<0
- S $P(X,U,2)=$P(X,U,2)+($G(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
- Q
- DCAN ;Accumulate Values by Direct issue Cans
- Q:ASUL(11,"TRN","TYPE")'=9 Q:$G(ASUT(ASUT,"CAN"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
- N X,Z
- S (X,ASUW("E#","CAN"))=$P(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2) S:X'?1N.N ASUW("E#","CAN")=+X
- S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- I Z="" D
- .S Z=ASUT(ASUT,"CAN")_U
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
- .S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- I $P(Z,U)'=ASUT(ASUT,"CAN") D
- .S ASUW("E#","CAN")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),""))
- .I ASUW("E#","CAN")']"" D
- ..S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),"J",2)) I (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0) S Y=-1 Q
- ..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- ..I Z="" D
- ...S Z=ASUT(ASUT,"CAN")_U
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
- ...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- ..I $P(Z,U)'=ASUT(ASUT,"CAN") D
- ...S Y=-1 Q
- S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
- I X="" S X=ASUT(ASUT,"ACC")_U_0
- Q:Y<0
- S $P(X,U,2)=$P(X,U,2)+($G(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
- Q
- TRN ;Accumulate Values by Transaction code
- ;Update Control sheet master for current month Item counts/Balances
- N X S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0))
- I X']"" D
- .S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- S $P(X,U,2)=$P(X,U,2)+1
- S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0)=X
- Q
- ASUMCUPD ; IHS/ITSC/LMH -CONTROL SHEET UPDATE ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine initializes Control Sheet Master for Fiscal Year Month
- +3 IF $GET(ASUMC(ASUMS("E#","STA"),0))']""
- SET ^ASUMC(ASUMS("E#","STA"),0)=ASUMS("E#","STA")
- +4 KILL ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"))
- +5 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),0)=ASUK("DT","FYM#")
- +6 IF $GET(ASUMC(ASUMS("E#","STA"),1,0))']""
- SET ^ASUMC(ASUMS("E#","STA"),1,0)="^9002037.01^^"
- +7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,0)="^9002037.11PA^^"
- +8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,0)="^9002037.12PA^^"
- +9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,0)="^9002037.13PA^^"
- +10 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,0)="^9002037.14PA^^"
- +11 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,0)="^9002037.15PA^^"
- +12 ;All control sheet data blank for fiscal year month
- +13 SET ASURX="W !?3,""Getting Month's Master Beginning Balances"""
- DO ^ASUUPLOG
- +14 SET ASUMS("E#","STA")=ASUL(2,"STA","E#")
- +15 IF $GET(ASUN("TYP"))']""
- DO RANGE^ASUURANG(2)
- +16 DO LOAD^ASUCOHKP(.ASUN)
- +17 NEW X,Y,Z
- +18 FOR X=1:1:5,9
- Begin DoDot:1
- +19 IF '$DATA(^TMP("ASUMC",$JOB,X))
- Begin DoDot:2
- +20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
- End DoDot:2
- QUIT
- +21 SET Y=0
- FOR
- SET Y=$ORDER(^TMP("ASUMC",$JOB,X,Y))
- IF Y']""
- QUIT
- Begin DoDot:2
- +22 IF $GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0))']""
- SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
- +23 SET Z=$GET(Z)+$PIECE(^TMP("ASUMC",$JOB,X,Y),U)
- End DoDot:2
- +24 SET $PIECE(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0),U,2)=Z
- KILL Z
- End DoDot:1
- +25 FOR
- SET ASUN("KEY")=$ORDER(^ASUH("B",ASUN("KEY")))
- IF ASUN("KEY")']""
- QUIT
- IF ASUN("KEY")>ASUN("EKY")
- QUIT
- Begin DoDot:1
- +26 SET ASUA=$ORDER(^ASUH("B",ASUN("KEY"),""))
- +27 ;Read history record
- NEW Y
- DO READ^ASU0TRRD(.ASUA,"H")
- IF Y<0
- QUIT
- +28 DO RPT1
- DO ACC
- DO VOU
- DO SCAN
- DO DCAN
- DO TRN
- End DoDot:1
- CLOSE ;
- +1 FOR X=1:1:5,9
- Begin DoDot:1
- +2 SET Z=^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)
- +3 ;W !?10,"OPEN : ",?20,Y
- SET Y=$PIECE(Z,U,2)
- +4 ;W !,"+REC: ",$P(Z,U,3)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,3)
- +5 ;W !,"+TFI: ",$P(Z,U,4)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,4)
- +6 ;W !,"+PVR: ",$P(Z,U,5)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,5)
- +7 ;W !,"-SKI: ",$P(Z,U,6)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,6)
- +8 ;W !,"-TFO: ",$P(Z,U,7)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,7)
- +9 ;W !,"+PVI: ",$P(Z,U,8)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,8)
- +10 ;W !,"+-ADJ: ",$P(Z,U,9)," = ",?20,Y
- SET Y=Y+$PIECE(Z,U,9)
- +11 SET $PIECE(Z,U,10)=Y
- +12 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=Z
- End DoDot:1
- +13 DO RPT1YTD
- +14 SET DIK="^ASUMC("
- DO IXALL^DIK
- +15 QUIT
- RPT1 ;Collect data for report 1
- CURMO ;Count transactions for report 1 - current month -subscript (2)
- +1 SET X=$GET(^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#")))
- +2 IF X']""
- SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- +3 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
- +4 SET ^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#"))=X
- TODAY ;Get active items (transactions posted today) beginning balances
- +1 IF $PIECE(ASUN("KEY"),"-",2)=ASUK("DT","RUN")
- Begin DoDot:1
- +2 ;Count transactions for report 1 - processed today -subscript (1)
- +3 SET X=$GET(^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#")))
- +4 IF X']""
- SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- +5 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
- +6 SET ^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#"))=X
- End DoDot:1
- +7 QUIT
- RPT1YTD ; Collect year to date item counts for report 1 - subscript (3)
- +1 ;M ^XTMP("ASUR","R01",3)=^XTMP("ASUR","R01",2) ;Start with current month
- +2 NEW W,X,Y,Z
- SET Z=ASUK("DT","FYM#")
- FOR Z=Z:-1:1
- Begin DoDot:1
- +3 SET Y=0
- FOR
- SET Y=$ORDER(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y))
- IF Y'?1N.N
- QUIT
- Begin DoDot:2
- +4 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0))
- SET W=$GET(^XTMP("ASUR","R01",3,Y))
- SET $PIECE(W,U)=Y
- SET $PIECE(W,U,2)=$PIECE(W,U,2)+$PIECE(X,U,2)
- SET ^XTMP("ASUR","R01",3,Y)=W
- End DoDot:2
- End DoDot:1
- +5 QUIT
- YEARCLR ;EP ;YEARLY CLEAR SUBSCRIPT 3
- +1 NEW W,X,Y,Z
- SET Z=ASUK("DT","FYM#")
- FOR Z=Z:-1:1
- Begin DoDot:1
- +2 SET Y=0
- FOR
- SET Y=$ORDER(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y))
- IF Y'?1N.N
- QUIT
- Begin DoDot:2
- +3 SET ^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)=""
- End DoDot:2
- End DoDot:1
- +4 QUIT
- ACC ;Accumulate value from transactions
- +1 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0))
- SET Z=ASUL(11,"TRN","TYPE")
- +2 IF X']""
- SET X=ASUT(ASUT,"ACC")_U
- +3 SET Y=$SELECT(Z=2:3,Z=8:4,Z=3:6,Z=9:7,Z=6:9,Z=0:11,1:Z)
- +4 IF Z=1
- QUIT
- +5 IF Z=2
- IF $EXTRACT(ASUT("TRCD"),2)="0"
- SET Y=5
- +6 IF Z=3
- IF $EXTRACT(ASUT("TRCD"),2)="0"
- SET Y=8
- +7 SET $PIECE(X,U,Y)=$PIECE(X,U,Y)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
- +8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)=X
- +9 QUIT
- VOU ;Accumulate Values by Vouchers
- +1 IF $GET(ASUT(ASUT,"VOU"))']""
- QUIT
- IF $GET(ASUT(ASUT,"ACC"))']""
- QUIT
- +2 NEW X,Z
- +3 SET ASUW("E#","VOU")=($PIECE(ASUT(ASUT,"VOU"),"-"))_($PIECE(ASUT(ASUT,"VOU"),"-",2))_($PIECE(ASUT(ASUT,"VOU"),"-",3))
- +4 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
- +5 IF Z=""
- Begin DoDot:1
- +6 SET Z=ASUT(ASUT,"VOU")_U
- +7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
- +8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
- +9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
- End DoDot:1
- +10 IF $PIECE(Z,U)'=ASUT(ASUT,"VOU")
- Begin DoDot:1
- +11 SET ASUW("E#","VOU")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),""))
- +12 IF ASUW("E#","VOU")']""
- Begin DoDot:2
- +13 SET ASUW("E#","VOU")=($PIECE(ASUT(ASUT,"VOU"),"-"))_(($PIECE(ASUT(ASUT,"VOU"),"-",2))_($PIECE(ASUT(ASUT,"VOU"),"-",3)))
- +14 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
- +15 IF Z=""
- Begin DoDot:3
- +16 SET Z=ASUT(ASUT,"VOU")_U
- +17 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
- +18 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
- +19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
- End DoDot:3
- +20 IF $PIECE(Z,U)'=ASUT(ASUT,"VOU")
- Begin DoDot:3
- +21 SET Y=-1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 IF Y<0
- QUIT
- +23 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0))
- +24 IF X=""
- SET X=ASUT(ASUT,"ACC")_U_0
- +25 SET $PIECE(X,U,2)=$PIECE(X,U,2)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
- +26 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0)=X
- +27 QUIT
- SCAN ;Accumulate Values by Stock Issue Cans
- +1 IF ASUL(11,"TRN","TYPE")'=3
- QUIT
- IF $GET(ASUT(ASUT,"CAN"))']""
- QUIT
- IF $GET(ASUT(ASUT,"ACC"))']""
- QUIT
- +2 NEW X,Z
- +3 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2))
- +4 IF ASUW("E#","CAN")'?1N.N
- SET ASUW("E#","CAN")=1
- +5 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- +6 IF Z=""
- Begin DoDot:1
- +7 SET Z=ASUT(ASUT,"CAN")_U
- +8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
- +9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
- +10 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- End DoDot:1
- +11 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- +12 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
- Begin DoDot:1
- +13 SET ASUW("E#","CAN")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),""))
- +14 IF ASUW("E#","CAN")']""
- Begin DoDot:2
- +15 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),"J",2))
- IF (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0)
- SET Y=-1
- QUIT
- +16 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
- +17 IF Z=""
- Begin DoDot:3
- +18 SET Z=ASUT(ASUT,"CAN")_U
- +19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
- +20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
- +21 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- End DoDot:3
- +22 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
- Begin DoDot:3
- +23 SET Y=-1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
- +25 IF X=""
- SET X=ASUT(ASUT,"ACC")_U_0
- +26 IF Y<0
- QUIT
- +27 SET $PIECE(X,U,2)=$PIECE(X,U,2)+($GET(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
- +28 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
- +29 QUIT
- DCAN ;Accumulate Values by Direct issue Cans
- +1 IF ASUL(11,"TRN","TYPE")'=9
- QUIT
- IF $GET(ASUT(ASUT,"CAN"))']""
- QUIT
- IF $GET(ASUT(ASUT,"ACC"))']""
- QUIT
- +2 NEW X,Z
- +3 SET (X,ASUW("E#","CAN"))=$PIECE(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2)
- IF X'?1N.N
- SET ASUW("E#","CAN")=+X
- +4 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- +5 IF Z=""
- Begin DoDot:1
- +6 SET Z=ASUT(ASUT,"CAN")_U
- +7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
- +8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
- +9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- End DoDot:1
- +10 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- +11 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
- Begin DoDot:1
- +12 SET ASUW("E#","CAN")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),""))
- +13 IF ASUW("E#","CAN")']""
- Begin DoDot:2
- +14 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),"J",2))
- IF (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0)
- SET Y=-1
- QUIT
- +15 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
- +16 IF Z=""
- Begin DoDot:3
- +17 SET Z=ASUT(ASUT,"CAN")_U
- +18 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
- +19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
- +20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
- End DoDot:3
- +21 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
- Begin DoDot:3
- +22 SET Y=-1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
- +24 IF X=""
- SET X=ASUT(ASUT,"ACC")_U_0
- +25 IF Y<0
- QUIT
- +26 SET $PIECE(X,U,2)=$PIECE(X,U,2)+($GET(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
- +27 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
- +28 QUIT
- TRN ;Accumulate Values by Transaction code
- +1 ;Update Control sheet master for current month Item counts/Balances
- +2 NEW X
- SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0))
- +3 IF X']""
- Begin DoDot:1
- +4 SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
- End DoDot:1
- +5 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
- +6 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0)=X
- +7 QUIT