ASUBTCH ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine will be used to process transactions already entred
D:'$D(U) ^XBKVAR D:'$D(ASUK) ^ASUVAR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
I $G(ASUL(1,"AR","STA1"))]"" D
.D STA^ASULARST(ASUL(1,"AR","STA1"))
.W !!,"Process transactions for Station: ",ASUL(2,"STA","NM")," - Code: ",ASUL(2,"STA","CD"),!
S ASUSB=1
F ASUJ=4,5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Add transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUT("TRCD")["A" D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN")-1 D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
F ASUJ=4,5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Change transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUT("TRCD")["C" D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
F ASUJ=5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Station User Level Change transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUT("TRCD")["B" D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
F ASUJ1=1,"2T",2,6,"3T",3,7 S ASUJ=$E(ASUJ1) W !,"Processing ",$P(^ASUT(ASUJ,0),U),$S($E(ASUJ1,2)="T":" Transfer ",1:"")," Debit transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUJ1="2T",ASUL(11,"TRN","TYPE")'=8 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
...I ASUJ1="3T",ASUL(11,"TRN","TYPE")'=9 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
...I ASUT(ASUT,"SIGN")=1 D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
F ASUJ1=1,"2T",2,6,"3T","3I",3,7 S ASUJ=$E(ASUJ1) W !,"Processing ",$P(^ASUT(ASUJ,0),U),$S($E(ASUJ1,2)="T":" Transfer ",$E(ASUJ1,2)="I":" Post Posted ",1:"")," Credit transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.I ASUJ1="3T"
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUJ1="2T",ASUL(11,"TRN","TYPE")'=8 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
...I ASUJ1="3T",ASUL(11,"TRN","TYPE")'=9 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
...I ASUJ1="3I",ASUT(ASUT,"PST")'="I" S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
...I ASUT(ASUT,"SIGN")=-1 D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
F ASUJ=5,4 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Delete transactions" D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" Q
.F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']"" D
..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']"" D
...I ASUT("TRCD")["D" D UPDT
...E S ASUC("TRN")=$G(ASUC("TRN"))-1
.W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT) Q:$D(DUOUT)
W !!,$FN(ASUC("TOT"),",")," Total Records processed." D PAZ^ASUURHDR
K ASUC,ASUT,ASUJ,ASUMX,ASUMS,ASUMK,ASUV
Q
UPDT ;EP ;Update masters
S ASUJ("RTN")=ASUJ_$E($G(ASUT),1,2)
I $G(ASUJ)']""!($G(ASUT)']"")!($G(ASUT("TRCD"))']"") S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
S ASUV("ASUT")=ASUT,ASUV("TRCD")=ASUT("TRCD")
S ASUJ("FILE")=9002036_"."_ASUJ
S ASUJ("GLOB")="^ASUT("_ASUJ_","
S ASUJ("TMPL")="[ASUJ"_ASUJ_$E(ASUT,1,3)_"]"
S DIE="9002036."_ASUJ,DA=ASUHDA,DDSFILE=ASUJ("FILE"),DDSPARM="CES",DR=ASUJ("TMPL")
D ^DDS
I $G(DDSSAVE)=1 D
.S DDSSAVE=""
.I ASUJ=1 D ^ASU1DUPD Q
.I ASUJ=2 D ^ASU2RUPD Q
.I ASUJ=3 D Q
..I $E(ASUT("TRCD"),2)?1N D
...I ASUT("TRCD")=32 D ^ASU3IUPD Q
...I ASUT("TRCD")=33 D ^ASU3IUPD Q
...D TXFIS^ASU3IUPD
..E D
...D RVIS^ASU3IUPD
.I ASUJ=4 D ^ASU4XUPD Q
.I ASUJ=5 D ^ASU5SUPD Q
.I ASUJ=6 D ^ASU6JUPD Q
.I ASUJ=7 D ^ASU7DUPD
E D
.S DIK=ASUJ("GLOB"),DA=ASUHDA D ^DIK
.S DDSSAVE=0
Q
TRRD ;EP ;Read transactions
D READ^ASU0TRRD(.ASUHDA,.ASUJ) Q
Q
CKFLD ;EP ;Validate fields for batch processing
D @(ASUJ)
Q
1 ;Due in validation
N F,M,X S M="E" F F="IDX","PON","QTY","VAL" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="R" S F="SSA" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
2 ;Receipt validation
N F,M,X S M="E" F F="VOU","PON","QTY","VAL","FPN" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="R" S F="SSA" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="F" S F="SRC" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D" F F="DTX","DTE" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
3 ;Issue validation
N F,M,X S M="E" F F="IDX","VOU","FPN","PST","QTYR","RTP" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="R" F F="SST","USR" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
;S M="F",F="SRC",X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
;S M="N" S F="VAL" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="AN" F F="CTG","RQN" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D",F="DTE",X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
4 ;Index validation
N F,M,X S M="E" F F="NSN" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="F" F F="ACC","SSO","CAT" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="N" S F="BCD" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="A" S F="AUI" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="AN" F F="DESC","CTG" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
5 ;Station validation
N F,M,X S M="E" F F="IDX","STA","VEN","ORD","EOQ" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="R" F F="SST","USR" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="A" S F="SUI" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="N" F F="UCS","LTM","SPQ","RPQ","ULQ" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
6 ;Adjustment validation
N F,M,X S M="E" F F="IDX","VOU" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="N" F F="QTY","VAL" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
7 ;Direct Issue validation
N F,M,X S M="E" F F="PON","VOU" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="R" F F="SST","USR" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="F" F F="ACC","DSO","SRC" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
S M="N" F F="QTY","VAL" D
.S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
Q
VAL(M,F,X) ;Validate and save field
N Z
I ASUJ<7,ASUT("TRCD")'="4A",$G(ASUT(ASUT,"PT","IDX"))]"" S ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX") D ^ASUMXDIO
I ASUJ<7,ASUJ'=4,ASUT("TRCD")'="5A",$G(ASUT(ASUT,"PT","STA"))]"",$G(ASUMS("E#","IDX"))]"" S ASUMS("E#","STA")=$G(ASUL("ST#")) D ^ASUMSTRD
I M="E" S Z="D "_F_"^ASUJVALF(.X,.DDSERROR)" X Z Q
S Z="D EN^ASUJVALD(.X,.DDSERROR,.F,.M)" X Z Q
Q
ASUBTCH ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine will be used to process transactions already entred
+3 IF '$DATA(U)
DO ^XBKVAR
IF '$DATA(ASUK)
DO ^ASUVAR
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+4 IF $GET(ASUL(1,"AR","STA1"))]""
Begin DoDot:1
+5 DO STA^ASULARST(ASUL(1,"AR","STA1"))
+6 WRITE !!,"Process transactions for Station: ",ASUL(2,"STA","NM")," - Code: ",ASUL(2,"STA","CD"),!
End DoDot:1
+7 SET ASUSB=1
+8 FOR ASUJ=4,5
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U)," Master Add transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+9 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+10 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+11 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+12 IF ASUT("TRCD")["A"
DO UPDT
+13 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+14 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")-1
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+15 FOR ASUJ=4,5
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U)," Master Change transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+16 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+17 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+18 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+19 IF ASUT("TRCD")["C"
DO UPDT
+20 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+21 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+22 FOR ASUJ=5
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U)," Station User Level Change transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+23 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+24 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+25 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+26 IF ASUT("TRCD")["B"
DO UPDT
+27 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+28 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+29 FOR ASUJ1=1,"2T",2,6,"3T",3,7
SET ASUJ=$EXTRACT(ASUJ1)
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U),$SELECT($EXTRACT(ASUJ1,2)="T":" Transfer ",1:"")," Debit transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+30 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+31 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+32 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+33 IF ASUJ1="2T"
IF ASUL(11,"TRN","TYPE")'=8
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+34 IF ASUJ1="3T"
IF ASUL(11,"TRN","TYPE")'=9
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+35 IF ASUT(ASUT,"SIGN")=1
DO UPDT
+36 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+37 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+38 FOR ASUJ1=1,"2T",2,6,"3T","3I",3,7
SET ASUJ=$EXTRACT(ASUJ1)
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U),$SELECT($EXTRACT(ASUJ1,2)="T":" Transfer ",$EXTRACT(ASUJ1,2)="I":" Post Posted ",1:"")," Credit transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+39 IF ASUJ1="3T"
+40 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+41 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+42 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+43 IF ASUJ1="2T"
IF ASUL(11,"TRN","TYPE")'=8
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+44 IF ASUJ1="3T"
IF ASUL(11,"TRN","TYPE")'=9
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+45 IF ASUJ1="3I"
IF ASUT(ASUT,"PST")'="I"
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+46 IF ASUT(ASUT,"SIGN")=-1
DO UPDT
+47 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+48 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+49 FOR ASUJ=5,4
WRITE !,"Processing ",$PIECE(^ASUT(ASUJ,0),U)," Master Delete transactions"
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+50 SET ASUV("E#")=0
IF '$DATA(^ASUT(ASUJ,"C","Y"))
WRITE !,"None entered"
QUIT
+51 FOR ASUC("TRN")=0:1
SET ASUV("E#")=$ORDER(^ASUT(ASUJ,"C","Y",ASUV("E#")))
IF ASUV("E#")']""
QUIT
Begin DoDot:2
+52 SET ASUT=0
SET ASUHDA=ASUV("E#")
DO TRRD
IF $GET(ASUT)']""
QUIT
Begin DoDot:3
+53 IF ASUT("TRCD")["D"
DO UPDT
+54 IF '$TEST
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
End DoDot:3
End DoDot:2
+55 WRITE " Count=",$FNUMBER(ASUC("TRN"),",")
SET ASUC("TOT")=$GET(ASUC("TOT"))+ASUC("TRN")
DO PAZ^ASUURHDR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
+56 WRITE !!,$FNUMBER(ASUC("TOT"),",")," Total Records processed."
DO PAZ^ASUURHDR
+57 KILL ASUC,ASUT,ASUJ,ASUMX,ASUMS,ASUMK,ASUV
+58 QUIT
UPDT ;EP ;Update masters
+1 SET ASUJ("RTN")=ASUJ_$EXTRACT($GET(ASUT),1,2)
+2 IF $GET(ASUJ)']""!($GET(ASUT)']"")!($GET(ASUT("TRCD"))']"")
SET ASUC("TRN")=$GET(ASUC("TRN"))-1
QUIT
+3 SET ASUV("ASUT")=ASUT
SET ASUV("TRCD")=ASUT("TRCD")
+4 SET ASUJ("FILE")=9002036_"."_ASUJ
+5 SET ASUJ("GLOB")="^ASUT("_ASUJ_","
+6 SET ASUJ("TMPL")="[ASUJ"_ASUJ_$EXTRACT(ASUT,1,3)_"]"
+7 SET DIE="9002036."_ASUJ
SET DA=ASUHDA
SET DDSFILE=ASUJ("FILE")
SET DDSPARM="CES"
SET DR=ASUJ("TMPL")
+8 DO ^DDS
+9 IF $GET(DDSSAVE)=1
Begin DoDot:1
+10 SET DDSSAVE=""
+11 IF ASUJ=1
DO ^ASU1DUPD
QUIT
+12 IF ASUJ=2
DO ^ASU2RUPD
QUIT
+13 IF ASUJ=3
Begin DoDot:2
+14 IF $EXTRACT(ASUT("TRCD"),2)?1N
Begin DoDot:3
+15 IF ASUT("TRCD")=32
DO ^ASU3IUPD
QUIT
+16 IF ASUT("TRCD")=33
DO ^ASU3IUPD
QUIT
+17 DO TXFIS^ASU3IUPD
End DoDot:3
+18 IF '$TEST
Begin DoDot:3
+19 DO RVIS^ASU3IUPD
End DoDot:3
End DoDot:2
QUIT
+20 IF ASUJ=4
DO ^ASU4XUPD
QUIT
+21 IF ASUJ=5
DO ^ASU5SUPD
QUIT
+22 IF ASUJ=6
DO ^ASU6JUPD
QUIT
+23 IF ASUJ=7
DO ^ASU7DUPD
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 SET DIK=ASUJ("GLOB")
SET DA=ASUHDA
DO ^DIK
+26 SET DDSSAVE=0
End DoDot:1
+27 QUIT
TRRD ;EP ;Read transactions
+1 DO READ^ASU0TRRD(.ASUHDA,.ASUJ)
QUIT
+2 QUIT
CKFLD ;EP ;Validate fields for batch processing
+1 DO @(ASUJ)
+2 QUIT
1 ;Due in validation
+1 NEW F,M,X
SET M="E"
FOR F="IDX","PON","QTY","VAL"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="R"
SET F="SSA"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+4 SET M="D"
SET F="DTE"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+5 QUIT
2 ;Receipt validation
+1 NEW F,M,X
SET M="E"
FOR F="VOU","PON","QTY","VAL","FPN"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="R"
SET F="SSA"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+4 SET M="F"
SET F="SRC"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+5 SET M="D"
FOR F="DTX","DTE"
Begin DoDot:1
+6 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+7 QUIT
3 ;Issue validation
+1 NEW F,M,X
SET M="E"
FOR F="IDX","VOU","FPN","PST","QTYR","RTP"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="R"
FOR F="SST","USR"
Begin DoDot:1
+4 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+5 ;S M="F",F="SRC",X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
+6 ;S M="N" S F="VAL" S X=$G(ASUT(ASUT,F)) Q:X']"" D VAL(.M,.F,.X)
+7 SET M="AN"
FOR F="CTG","RQN"
Begin DoDot:1
+8 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+9 SET M="D"
SET F="DTE"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+10 QUIT
4 ;Index validation
+1 NEW F,M,X
SET M="E"
FOR F="NSN"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="F"
FOR F="ACC","SSO","CAT"
Begin DoDot:1
+4 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+5 SET M="N"
SET F="BCD"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+6 SET M="A"
SET F="AUI"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+7 SET M="AN"
FOR F="DESC","CTG"
Begin DoDot:1
+8 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+9 SET M="D"
SET F="DTE"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+10 QUIT
5 ;Station validation
+1 NEW F,M,X
SET M="E"
FOR F="IDX","STA","VEN","ORD","EOQ"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="R"
FOR F="SST","USR"
Begin DoDot:1
+4 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+5 SET M="A"
SET F="SUI"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+6 SET M="N"
FOR F="UCS","LTM","SPQ","RPQ","ULQ"
Begin DoDot:1
+7 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+8 SET M="D"
SET F="DTE"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+9 QUIT
6 ;Adjustment validation
+1 NEW F,M,X
SET M="E"
FOR F="IDX","VOU"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="N"
FOR F="QTY","VAL"
Begin DoDot:1
+4 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+5 SET M="D"
SET F="DTE"
SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
+6 QUIT
7 ;Direct Issue validation
+1 NEW F,M,X
SET M="E"
FOR F="PON","VOU"
Begin DoDot:1
+2 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+3 SET M="R"
FOR F="SST","USR"
Begin DoDot:1
+4 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+5 SET M="F"
FOR F="ACC","DSO","SRC"
Begin DoDot:1
+6 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+7 SET M="N"
FOR F="QTY","VAL"
Begin DoDot:1
+8 SET X=$GET(ASUT(ASUT,F))
IF X']""
QUIT
DO VAL(.M,.F,.X)
End DoDot:1
+9 QUIT
VAL(M,F,X) ;Validate and save field
+1 NEW Z
+2 IF ASUJ<7
IF ASUT("TRCD")'="4A"
IF $GET(ASUT(ASUT,"PT","IDX"))]""
SET ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX")
DO ^ASUMXDIO
+3 IF ASUJ<7
IF ASUJ'=4
IF ASUT("TRCD")'="5A"
IF $GET(ASUT(ASUT,"PT","STA"))]""
IF $GET(ASUMS("E#","IDX"))]""
SET ASUMS("E#","STA")=$GET(ASUL("ST#"))
DO ^ASUMSTRD
+4 IF M="E"
SET Z="D "_F_"^ASUJVALF(.X,.DDSERROR)"
XECUTE Z
QUIT
+5 SET Z="D EN^ASUJVALD(.X,.DDSERROR,.F,.M)"
XECUTE Z
QUIT
+6 QUIT
