ASUMYDPS ; IHS/ITSC/LMH -UPDATE YTD ISSUE DATA MASTER ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine updates the YTD Issue Data Master file with information
;from both Stock and Direct Issues as they are posted.
N Q S Q=$S(ASUT(ASUT,"PT","REQ")?8N:ASUT(ASUT,"PT","REQ"),1:ASUT(ASUT,"USR"))
D REQ^ASUMYDIO(.Q) ;Lookup REQ in YTD Issue Data master
I Y<1 D Q:DDSERROR
.S DDSERROR=0 I Y=0 D
..D ADDREQ^ASUMYDIO(ASUMY("E#","REQ")) ;Add Requsitioner to YTD Issue Data master
..I Y<0 D
...N Z S Z="Error adding Requsitioner : "_ASUT(ASUT,"USR")_" to YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=1 ;DFM P1 9/1/98
.E D
..N Z S Z="Error finding Requsitioner : "_ASUT(ASUT,"USR")_" for YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=2 ;DFM P1 9/1/98
I ASUT("TRCD")="5B" Q
N S S S=$S(ASUT(ASUT,"PT","SSA")?5N:ASUT(ASUT,"PT","SSA"),1:ASUT(ASUT,"SSA"))
D SSA^ASUMYDIO(.S) ;Lookup SSA in YTD Issue Data master
S DDSERROR=0 I Y<1 D Q:DDSERROR
.I Y=0 D
..D ADDSSA^ASUMYDIO(ASUMY("E#","SSA")) ;Add SSA to YTD Issue Data master
..I Y<0 D
...N Z S Z="ASUYUPD err adding SSA : "_ASUT(ASUT,"SSA")_" to YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=3 ;DFM P1 9/1/98
.E D
..N Z S Z="ASUYUPD err finding SSA : "_ASUT(ASUT,"SSA")_" for YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=4 ;DFM P1 9/1/98
I $G(ASUMX("ACC"))="" S ASUMX("ACC")=ASUT(ASUT,"ACC")
D ACC^ASUMYDIO(ASUT(ASUT,"ACC")) ;Lookup ACCT in YTD Issue Data master
S DDSERROR=0 I Y<1 D Q:DDSERROR
.I Y=0 D
..D ADDACC^ASUMYDIO(ASUMY("E#","ACC")) ;Add ACC to YTD Issue Data master
..I Y<0 D
...N Z S Z="ASUYUPD err adding Account : "_ASUT(ASUT,"ACC")_" to YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=5 ;DFM P1 9/1/98
.E D
..N Z S Z="ASUYUPD err finding Account : "_ASUT(ASUT,"ACC")_" for YTD DATA : "_Y W *7 D MSG^ASUJHELP(.Z) S DDSERROR=6 ;DFM P1 9/1/98
D READ^ASUMYDIO ;Read YTD Issue Data master into variables
I $E(ASUT("TRCD"))=3 D
.S:'$D(ASUV("VOU")) ASUV("VOU")=""
.I ASUL(11,"TRN","REV") D
..I ASUT("TRCD")="3K" D
...S ASUMY("CMO","RCR","VAL")=$G(ASUMY("CMO","RCR","VAL"))-(ASUT(ASUT,"VAL"))
...S ASUMY("YTD","RCR","VAL")=$G(ASUMY("YTD","RCR","VAL"))-(ASUT(ASUT,"VAL"))
..I ASUT("TRCD")="3L" D
...S ASUMY("YTD","NRC","VAL")=$G(ASUMY("YTD","NRC","VAL"))-(ASUT(ASUT,"VAL"))
..I ASUT("TRCD")'="3K" Q
..I ASUT(ASUT,"REQ TYP")=1 S ASUMY("CMO","SCH","LI")=$G(ASUMY("CMO","SCH","LI"))-1,ASUMY("YTD","SCH","LI")=$G(ASUMY("YTD","SCH","LI"))-1
..I ASUT(ASUT,"REQ TYP")=2 S ASUMY("CMO","USC","LI")=$G(ASUMY("CMO","USC","LI"))-1,ASUMY("YTD","USC","LI")=$G(ASUMY("YTD","USC","LI"))-1
.E D
..I ASUT("TRCD")=32!(ASUT("TRCD")=31) D
...S ASUMY("CMO","RCR","VAL")=$G(ASUMY("CMO","RCR","VAL"))+(ASUT(ASUT,"VAL"))
...S ASUMY("YTD","RCR","VAL")=$G(ASUMY("YTD","RCR","VAL"))+(ASUT(ASUT,"VAL"))
..I ASUT("TRCD")=33 D
...S ASUMY("YTD","NRC","VAL")=$G(ASUMY("YTD","NRC","VAL"))+(ASUT(ASUT,"VAL"))
..I ASUT("TRCD")'=32 Q
..I ASUT(ASUT,"REQ TYP")=1 D
...S ASUMY("CMO","SCH","LI")=$G(ASUMY("CMO","SCH","LI"))+1
...S ASUMY("YTD","SCH","LI")=$G(ASUMY("YTD","SCH","LI"))+1
...N V S V=$P(ASUT(ASUT,"VOU"),"-")_$P(ASUT(ASUT,"VOU"),"-",2) I V=ASUK("DT","FYMO")&(ASUT(ASUT,"VOU")'=$G(ASUV("VOU"))) D
....S ASUMY("CMO","SCH","DOC")=$G(ASUMY("CMO","SCH","DOC"))+1
....S ASUMY("YTD","SCH","DOC")=$G(ASUMY("YTD","SCH","DOC"))+1
....S ASUV("VOU")=ASUT(ASUT,"VOU")
..I ASUT(ASUT,"REQ TYP")=2 D
...S ASUMY("CMO","USC","LI")=$G(ASUMY("CMO","USC","LI"))+1
...S ASUMY("YTD","USC","LI")=$G(ASUMY("YTD","USC","LI"))+1
...N V S V=$P(ASUT(ASUT,"VOU"),"-")_$P(ASUT(ASUT,"VOU"),"-",2) I V=ASUK("DT","FYMO")&(ASUT(ASUT,"VOU")'=$G(ASUV("VOU"))) D
....S ASUMY("CMO","USC","DOC")=$G(ASUMY("CMO","USC","DOC"))+1
....S ASUMY("YTD","USC","DOC")=$G(ASUMY("YTD","USC","DOC"))+1
....S ASUV("VOU")=ASUT(ASUT,"VOU")
..I ASUT(ASUT,"FPN")="N" S ASUMY("IS0","LI")=$G(ASUMY("IS0","LI"))+1
..I ASUT(ASUT,"FPN")="P" S ASUMY("ISP","LI")=$G(ASUMY("ISP","LI"))+1
..I ASUT(ASUT,"B/O")="B" S ASUMY("B/O","LI")=$G(ASUMY("B/O","LI"))+1
..I ASUT(ASUT,"QTY","ADJ")="A" S ASUMY("QTYADJ","LI")=$G(ASUMY("QTYADJ","LI"))+1
E D
.I ASUL(11,"TRN","REV") D
..S ASUMY("CMO","DIR","VAL")=ASUMY("CMO","DIR","VAL")-(ASUT(ASUT,"VAL"))
..S ASUMY("YTD","DIR","VAL")=ASUMY("YTD","DIR","VAL")-(ASUT(ASUT,"VAL"))
..S ASUMY("CMO","DIR","LI")=ASUMY("CMO","DIR","LI")-ASUT(ASUT,"QTY","ISS")
..S ASUMY("YTD","DIR","LI")=ASUMY("YTD","DIR","LI")-ASUT(ASUT,"QTY","ISS")
..S ASUMY("CMO","DIR","DOC")=ASUMY("CMO","DIR","DOC")-1
..S ASUMY("YTD","DIR","DOC")=ASUMY("YTD","DIR","DOC")-1
.E D
..S ASUMY("CMO","DIR","VAL")=ASUMY("CMO","DIR","VAL")+(ASUT(ASUT,"VAL"))
..S ASUMY("YTD","DIR","VAL")=ASUMY("YTD","DIR","VAL")+(ASUT(ASUT,"VAL"))
..S ASUMY("CMO","DIR","LI")=ASUMY("CMO","DIR","LI")+ASUT(ASUT,"QTY","ISS")
..S ASUMY("YTD","DIR","LI")=ASUMY("YTD","DIR","LI")+ASUT(ASUT,"QTY","ISS")
..S ASUMY("CMO","DIR","DOC")=ASUMY("CMO","DIR","DOC")+1
..S ASUMY("YTD","DIR","DOC")=ASUMY("YTD","DIR","DOC")+1
D WRITY^ASUMYDIO ;Write YTD Issue Data master from variables
Q
MO ;EP; RESET YTD ISSUE DATA BEGIN OF MO PROC
S (ASUMY("E#","REQ"),ASUMY("E#","SST"),ASUMY("E#","SSA"),ASUMY("E#","ACC"))=0,ASUMY("NOKL")=1
F S ASUMY("E#","REQ")=$O(^ASUMY(ASUMY("E#","REQ"))) Q:ASUMY("E#","REQ")'?1N.N D
.F S ASUMY("E#","SST")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SST"))) Q:ASUMY("E#","SST")'?1N.N D
..F S ASUMY("E#","SSA")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"))) Q:ASUMY("E#","SSA")'?1N.N D
...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 S X=0
....F S X=$O(ASUMY("CMO",X)) Q:X']"" S Y=0 D
.....F S Y=$O(ASUMY("CMO",X,Y)) Q:Y']"" S ASUMY("CMO",X,Y)=""
....D WRITY^ASUMYDIO
...S ASUMY("E#","ACC")=0
..S ASUMY("E#","SSA")=0
.S ASUMY("E#","SST")=0
K DR,DIE,DA,ASUMU,ASUMU,ASUMY,ASU
Q
ASUMYDPS ; IHS/ITSC/LMH -UPDATE YTD ISSUE DATA MASTER ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine updates the YTD Issue Data Master file with information
+3 ;from both Stock and Direct Issues as they are posted.
+4 NEW Q
SET Q=$SELECT(ASUT(ASUT,"PT","REQ")?8N:ASUT(ASUT,"PT","REQ"),1:ASUT(ASUT,"USR"))
+5 ;Lookup REQ in YTD Issue Data master
DO REQ^ASUMYDIO(.Q)
+6 IF Y<1
Begin DoDot:1
+7 SET DDSERROR=0
IF Y=0
Begin DoDot:2
+8 ;Add Requsitioner to YTD Issue Data master
DO ADDREQ^ASUMYDIO(ASUMY("E#","REQ"))
+9 IF Y<0
Begin DoDot:3
+10 ;DFM P1 9/1/98
NEW Z
SET Z="Error adding Requsitioner : "_ASUT(ASUT,"USR")_" to YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=1
End DoDot:3
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 ;DFM P1 9/1/98
NEW Z
SET Z="Error finding Requsitioner : "_ASUT(ASUT,"USR")_" for YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=2
End DoDot:2
End DoDot:1
IF DDSERROR
QUIT
+13 IF ASUT("TRCD")="5B"
QUIT
+14 NEW S
SET S=$SELECT(ASUT(ASUT,"PT","SSA")?5N:ASUT(ASUT,"PT","SSA"),1:ASUT(ASUT,"SSA"))
+15 ;Lookup SSA in YTD Issue Data master
DO SSA^ASUMYDIO(.S)
+16 SET DDSERROR=0
IF Y<1
Begin DoDot:1
+17 IF Y=0
Begin DoDot:2
+18 ;Add SSA to YTD Issue Data master
DO ADDSSA^ASUMYDIO(ASUMY("E#","SSA"))
+19 IF Y<0
Begin DoDot:3
+20 ;DFM P1 9/1/98
NEW Z
SET Z="ASUYUPD err adding SSA : "_ASUT(ASUT,"SSA")_" to YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=3
End DoDot:3
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 ;DFM P1 9/1/98
NEW Z
SET Z="ASUYUPD err finding SSA : "_ASUT(ASUT,"SSA")_" for YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=4
End DoDot:2
End DoDot:1
IF DDSERROR
QUIT
+23 IF $GET(ASUMX("ACC"))=""
SET ASUMX("ACC")=ASUT(ASUT,"ACC")
+24 ;Lookup ACCT in YTD Issue Data master
DO ACC^ASUMYDIO(ASUT(ASUT,"ACC"))
+25 SET DDSERROR=0
IF Y<1
Begin DoDot:1
+26 IF Y=0
Begin DoDot:2
+27 ;Add ACC to YTD Issue Data master
DO ADDACC^ASUMYDIO(ASUMY("E#","ACC"))
+28 IF Y<0
Begin DoDot:3
+29 ;DFM P1 9/1/98
NEW Z
SET Z="ASUYUPD err adding Account : "_ASUT(ASUT,"ACC")_" to YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=5
End DoDot:3
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 ;DFM P1 9/1/98
NEW Z
SET Z="ASUYUPD err finding Account : "_ASUT(ASUT,"ACC")_" for YTD DATA : "_Y
WRITE *7
DO MSG^ASUJHELP(.Z)
SET DDSERROR=6
End DoDot:2
End DoDot:1
IF DDSERROR
QUIT
+32 ;Read YTD Issue Data master into variables
DO READ^ASUMYDIO
+33 IF $EXTRACT(ASUT("TRCD"))=3
Begin DoDot:1
+34 IF '$DATA(ASUV("VOU"))
SET ASUV("VOU")=""
+35 IF ASUL(11,"TRN","REV")
Begin DoDot:2
+36 IF ASUT("TRCD")="3K"
Begin DoDot:3
+37 SET ASUMY("CMO","RCR","VAL")=$GET(ASUMY("CMO","RCR","VAL"))-(ASUT(ASUT,"VAL"))
+38 SET ASUMY("YTD","RCR","VAL")=$GET(ASUMY("YTD","RCR","VAL"))-(ASUT(ASUT,"VAL"))
End DoDot:3
+39 IF ASUT("TRCD")="3L"
Begin DoDot:3
+40 SET ASUMY("YTD","NRC","VAL")=$GET(ASUMY("YTD","NRC","VAL"))-(ASUT(ASUT,"VAL"))
End DoDot:3
+41 IF ASUT("TRCD")'="3K"
QUIT
+42 IF ASUT(ASUT,"REQ TYP")=1
SET ASUMY("CMO","SCH","LI")=$GET(ASUMY("CMO","SCH","LI"))-1
SET ASUMY("YTD","SCH","LI")=$GET(ASUMY("YTD","SCH","LI"))-1
+43 IF ASUT(ASUT,"REQ TYP")=2
SET ASUMY("CMO","USC","LI")=$GET(ASUMY("CMO","USC","LI"))-1
SET ASUMY("YTD","USC","LI")=$GET(ASUMY("YTD","USC","LI"))-1
End DoDot:2
+44 IF '$TEST
Begin DoDot:2
+45 IF ASUT("TRCD")=32!(ASUT("TRCD")=31)
Begin DoDot:3
+46 SET ASUMY("CMO","RCR","VAL")=$GET(ASUMY("CMO","RCR","VAL"))+(ASUT(ASUT,"VAL"))
+47 SET ASUMY("YTD","RCR","VAL")=$GET(ASUMY("YTD","RCR","VAL"))+(ASUT(ASUT,"VAL"))
End DoDot:3
+48 IF ASUT("TRCD")=33
Begin DoDot:3
+49 SET ASUMY("YTD","NRC","VAL")=$GET(ASUMY("YTD","NRC","VAL"))+(ASUT(ASUT,"VAL"))
End DoDot:3
+50 IF ASUT("TRCD")'=32
QUIT
+51 IF ASUT(ASUT,"REQ TYP")=1
Begin DoDot:3
+52 SET ASUMY("CMO","SCH","LI")=$GET(ASUMY("CMO","SCH","LI"))+1
+53 SET ASUMY("YTD","SCH","LI")=$GET(ASUMY("YTD","SCH","LI"))+1
+54 NEW V
SET V=$PIECE(ASUT(ASUT,"VOU"),"-")_$PIECE(ASUT(ASUT,"VOU"),"-",2)
IF V=ASUK("DT","FYMO")&(ASUT(ASUT,"VOU")'=$GET(ASUV("VOU")))
Begin DoDot:4
+55 SET ASUMY("CMO","SCH","DOC")=$GET(ASUMY("CMO","SCH","DOC"))+1
+56 SET ASUMY("YTD","SCH","DOC")=$GET(ASUMY("YTD","SCH","DOC"))+1
+57 SET ASUV("VOU")=ASUT(ASUT,"VOU")
End DoDot:4
End DoDot:3
+58 IF ASUT(ASUT,"REQ TYP")=2
Begin DoDot:3
+59 SET ASUMY("CMO","USC","LI")=$GET(ASUMY("CMO","USC","LI"))+1
+60 SET ASUMY("YTD","USC","LI")=$GET(ASUMY("YTD","USC","LI"))+1
+61 NEW V
SET V=$PIECE(ASUT(ASUT,"VOU"),"-")_$PIECE(ASUT(ASUT,"VOU"),"-",2)
IF V=ASUK("DT","FYMO")&(ASUT(ASUT,"VOU")'=$GET(ASUV("VOU")))
Begin DoDot:4
+62 SET ASUMY("CMO","USC","DOC")=$GET(ASUMY("CMO","USC","DOC"))+1
+63 SET ASUMY("YTD","USC","DOC")=$GET(ASUMY("YTD","USC","DOC"))+1
+64 SET ASUV("VOU")=ASUT(ASUT,"VOU")
End DoDot:4
End DoDot:3
+65 IF ASUT(ASUT,"FPN")="N"
SET ASUMY("IS0","LI")=$GET(ASUMY("IS0","LI"))+1
+66 IF ASUT(ASUT,"FPN")="P"
SET ASUMY("ISP","LI")=$GET(ASUMY("ISP","LI"))+1
+67 IF ASUT(ASUT,"B/O")="B"
SET ASUMY("B/O","LI")=$GET(ASUMY("B/O","LI"))+1
+68 IF ASUT(ASUT,"QTY","ADJ")="A"
SET ASUMY("QTYADJ","LI")=$GET(ASUMY("QTYADJ","LI"))+1
End DoDot:2
End DoDot:1
+69 IF '$TEST
Begin DoDot:1
+70 IF ASUL(11,"TRN","REV")
Begin DoDot:2
+71 SET ASUMY("CMO","DIR","VAL")=ASUMY("CMO","DIR","VAL")-(ASUT(ASUT,"VAL"))
+72 SET ASUMY("YTD","DIR","VAL")=ASUMY("YTD","DIR","VAL")-(ASUT(ASUT,"VAL"))
+73 SET ASUMY("CMO","DIR","LI")=ASUMY("CMO","DIR","LI")-ASUT(ASUT,"QTY","ISS")
+74 SET ASUMY("YTD","DIR","LI")=ASUMY("YTD","DIR","LI")-ASUT(ASUT,"QTY","ISS")
+75 SET ASUMY("CMO","DIR","DOC")=ASUMY("CMO","DIR","DOC")-1
+76 SET ASUMY("YTD","DIR","DOC")=ASUMY("YTD","DIR","DOC")-1
End DoDot:2
+77 IF '$TEST
Begin DoDot:2
+78 SET ASUMY("CMO","DIR","VAL")=ASUMY("CMO","DIR","VAL")+(ASUT(ASUT,"VAL"))
+79 SET ASUMY("YTD","DIR","VAL")=ASUMY("YTD","DIR","VAL")+(ASUT(ASUT,"VAL"))
+80 SET ASUMY("CMO","DIR","LI")=ASUMY("CMO","DIR","LI")+ASUT(ASUT,"QTY","ISS")
+81 SET ASUMY("YTD","DIR","LI")=ASUMY("YTD","DIR","LI")+ASUT(ASUT,"QTY","ISS")
+82 SET ASUMY("CMO","DIR","DOC")=ASUMY("CMO","DIR","DOC")+1
+83 SET ASUMY("YTD","DIR","DOC")=ASUMY("YTD","DIR","DOC")+1
End DoDot:2
End DoDot:1
+84 ;Write YTD Issue Data master from variables
DO WRITY^ASUMYDIO
+85 QUIT
MO ;EP; RESET YTD ISSUE DATA BEGIN OF MO PROC
+1 SET (ASUMY("E#","REQ"),ASUMY("E#","SST"),ASUMY("E#","SSA"),ASUMY("E#","ACC"))=0
SET ASUMY("NOKL")=1
+2 FOR
SET ASUMY("E#","REQ")=$ORDER(^ASUMY(ASUMY("E#","REQ")))
IF ASUMY("E#","REQ")'?1N.N
QUIT
Begin DoDot:1
+3 FOR
SET ASUMY("E#","SST")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SST")))
IF ASUMY("E#","SST")'?1N.N
QUIT
Begin DoDot:2
+4 FOR
SET ASUMY("E#","SSA")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA")))
IF ASUMY("E#","SSA")'?1N.N
QUIT
Begin DoDot:3
+5 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:4
+6 DO READ^ASUMYDIO
SET X=0
+7 FOR
SET X=$ORDER(ASUMY("CMO",X))
IF X']""
QUIT
SET Y=0
Begin DoDot:5
+8 FOR
SET Y=$ORDER(ASUMY("CMO",X,Y))
IF Y']""
QUIT
SET ASUMY("CMO",X,Y)=""
End DoDot:5
+9 DO WRITY^ASUMYDIO
End DoDot:4
+10 SET ASUMY("E#","ACC")=0
End DoDot:3
+11 SET ASUMY("E#","SSA")=0
End DoDot:2
+12 SET ASUMY("E#","SST")=0
End DoDot:1
+13 KILL DR,DIE,DA,ASUMU,ASUMU,ASUMY,ASU
+14 QUIT
