- ASUJTRAN ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine will be used for transaction entry and review
- ;Modified in ENTR to enable multiple can selection LMH 11/22/99
- D:'$D(U) ^XBKVAR D:'$D(ASUK) ^ASUVAR I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) Q
- I $G(ASUL(2,"STA","CD"))]"" D
- .W !!,"Data entry for Station: ",ASUL(2,"STA","NM")," - Code: ",ASUL(2,"STA","CD"),!
- E D Q:'$D(ASUL(2))
- .K DIR S DIR(0)="P^9002039.02",DIR("A")="Enter Station Code" D ^DIR
- .Q:$D(DTOUT) Q:$D(DUOUT) Q:Y<0
- .D STA^ASULARST(Y)
- W ! K DIR S DIR(0)="SB^1:DUE IN;2:RECEIPT;3:ISSUE;4:INDEX;5:STATION;6:ADJUSTMENT;7:DIRECT ISSUE;8:TRANSFER ISSUE;9:BACKORDER CANCEL",DIR("A")="Enter Transaction Type" D ^DIR
- Q:$D(DTOUT) Q:$D(DUOUT)
- S ASUJ=Y,ASUT=$E(Y(0),1,3),ASUJ("RTN")=$E(ASUT,1,2)
- G @ASUJ
- W !,"Error - invalid transaction type entered"
- Q
- 1 ;DUEIN
- N DIR
- S DIR(0)="SB^12:PURCHASED;14:UNREQUIRED;15:DONATED;16:EXCESS;1K:CANCEL PURCHASED;1M:CANCEL UNREQUIRED;1N:CANCEL DONATED;1O:CANCEL EXCESS"
- G SELECT
- 2 ;RECEIPT
- N DIR
- S ASUJ("RTN")="RC"
- S DIR(0)="SB^22:PURCHASED;24:UNREQUIRED;25:DONATED;26:EXCESS;2K:REVERSAL PURCHASED;2M:REVERSAL UNREQUIRED;2N:REVERSAL DONATED;1O:REVERSAL EXCESS"
- G SELECT
- 3 ;ISSUE
- S DIR(0)="SB^32:REPLENISHMENT;33:NON REPLENISHMENT;3K:REVERSAL REPLENISHMENT;3L:REVERSAL NON REPLENISHMENT"
- G SELECT
- 4 ;INDEX
- S ASUT="IDX",ASUJ("RTN")="IX"
- S DIR(0)="SB^4A:ADD;4C:CHANGE;4D:DELETE"
- G SELECT
- 5 ;STATION
- S DIR(0)="SB^5A:ADD;5B:USER LEVEL;5C:CHANGE;5D:DELETE"
- G SELECT
- 6 ;ADJUSTMENT
- S ASUJ("RTN")="AJ"
- S DIR(0)="SB^27:DEBIT;37:CREDIT;2K:REVERSAL DEBIT;3K:REVERSAL CREDIT"
- G SELECT
- 7 ;DIRECT ISSUE
- S DIR(0)="SB^02:PURCHASED;04:UNREQUIRED;05:DONATED;06:EXCESS;0K:REVERSAL PURCHASED;0M:REVERSAL UNREQUIRED;0N:REVERSAL DONATED;1O:REVERSAL EXCESS"
- G SELECT
- 8 ;TRANSFER ISSUE
- S ASUJ=3
- S DIR(0)="SB^34:UNREQUIRED;36:EXCESS;3M:REVERSAL UNREQUIRED;3O:REVERSAL EXCESS"
- G SELECT
- 9 ;BACKORDER CANCEL
- S ASUJ=3,ASUT="CBO",ASUT("TRCD")="3J",ASUJ("RTN")="BO"
- G SELECTED
- SELECT ;SELECT TRANSATION CODE
- W ! S DIR("A")="Enter Transaction Code" D ^DIR Q:$D(DTOUT) Q:$D(DUOUT)
- S ASUT("TRCD")=Y
- S:$E(ASUT("TRCD"))=4 ASUT=$S($E(ASUT("TRCD"),2)="A":"XAD",$E(ASUT("TRCD"),2)="C":"XCG",$E(ASUT("TRCD"),2)="D":"XDL",1:"")
- S:$E(ASUT("TRCD"))=5 ASUT=$S($E(ASUT("TRCD"),2)="A":"SAD",$E(ASUT("TRCD"),2)="C":"SCG",$E(ASUT("TRCD"),2)="D":"SDL",1:"STB")
- SELECTED ;EP ;
- S:$G(ASUJ("RTN"))="" ASUJ("RTN")=$E($G(ASUT),1,2)
- S ASUJ("RTN")=ASUJ_ASUJ("RTN"),ASUF("TRAN")=0
- D ENTR
- K ASUF("TRAN") Q
- ENTR ;EP - Call Screenman for transaction entry
- I $G(ASUJ)=""!($G(ASUT)="")!($G(ASUT("TRCD")))="" Q
- ;Q:$G(ASUJ)']"" Q:$G(ASUT)']"" Q:$G(ASUT("TRCD"))']""
- S ASUV("ASUT")=ASUT,ASUV("TRCD")=ASUT("TRCD"),ASUT("TYPE")=ASUJ
- S ASUJ("FILE")=9002036_"."_ASUJ
- S ASUJ("GLOB")="^ASUT("_ASUJ_","
- S ASUJ("TMPL")="[ASUJ"_ASUJ_$E(ASUT,1,3)_"]"
- S ASUJ("WRIT")="S ASUF(""SV"")=1 D WRITE^ASU0TRWR(DA,.ASUJ)"
- S ASUJ("NEXT")="S DA=$O(^ASUT("_ASUJ_",9999999999),-1)+1"
- S ASUPOP="" ;WAR 4/30/99 prevents UPDT from being performed if need B
- N Z S Z=$G(ASUT("TRCD")) D TRN^ASULARST("T"_Z) S ASUT(ASUT,"SIGN")=$G(ASUL(11,"TRN","DRCR"))
- I $G(ASUF("TRAN"))=0 D NEWTRAN
- F ASUC("TRN")=0:1 D Q:$G(DDSSAVE)=0
- .I ASUPOP S ASUC("TRN")=ASUC("TRN")-1 ;WAR 4/30/99
- .S ASUPOP=0
- .D DUP S ASUHDA=DA,DDSFILE=ASUJ("FILE"),DDSPARM="CES",DR=ASUJ("TMPL")
- .I ASUT("TRCD")["3"!(ASUT("TRCD")["0") S ASUDDS=1 ;WAR 11/22/99
- .D ^DDS
- .S ASUDDS=0 ;LMH 11/22/99 Reset ASUDDS
- .I $G(DDSSAVE)=1&('ASUPOP) D ;WAR 4/28/99 ASUPOP set in ASUJHELP
- ..D UPDT
- .E D
- ..S DIK=ASUJ("GLOB"),DA=ASUHDA D ^DIK
- ..;REM'D WAR - 2/19/99 W !,"RECORD NOT SAVED!" D PAZ^ASUURHDR
- ..S DDSSAVE=0
- W !,$FN(ASUC("TRN"),",")," Records Entered during this session."
- D PAZ^ASUURHDR
- K ASU("STARTING DA"),ASU("DA CNT")
- K ASUC,ASUT,ASUJ,ASUJT,ASUMX,ASUMS,ASUMK,ASUV,ASUDDS
- K ASUL(3),ASUL(7),ASUL(8),ASUL(9),ASUL(10),ASUL(11)
- K ASUL(4),ASUL(5),ASUL(17),ASUL(18),ASUL(19),ASUL(20),ASUL(22)
- Q
- UPDT ;EP ;Update masters
- S DDSSAVE=""
- I ASUJ=1 D ^ASU1DUPD Q
- I ASUJ=2 D ^ASU2RUPD Q
- I ASUJ=3 D Q
- .I ASUT("TRCD")="3J" D BKORDCAN^ASU3BKOR 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
- Q
- DUP ;EP ;Duplicate data from transaction
- S ASUT=ASUV("ASUT"),ASUT("TRCD")=ASUV("TRCD") D DAYTIM^ASUUDATE S ASUJT("TRKY")=$G(ASUT(ASUT,"TRKY"))
- M ASUT(ASUT)=ASUJT
- S:$G(ASUT("TYPE"))']"" ASUT("TYPE")=$G(ASUJ)
- X ASUJ("NEXT")
- ;WAR 4/26/99 REM'D->S ASUF("SV")=1 X ASUJ("WRIT")
- X ASUJ("WRIT")
- F Z=3:1:10,12:1:22 K ASUL(Z)
- Q
- NEWTRAN ;
- I '$D(ASUL(1)) D SETAREA^ASULARST
- I '$D(DUZ) D ^XBKVAR
- S ASUF("TRAN")=1
- S:$G(ASUT("TYPE"))']"" ASUT("TYPE")=$G(ASUJ)
- S ASUT=ASUV("ASUT"),ASUT("TRCD")=ASUV("TRCD")
- S ASUT(ASUT,"ACC")="",ASUT(ASUT,"PT","ACC")=""
- S ASUT(ASUT,"PT","AR")=$G(ASUL(1,"AR","AP")),ASUT(ASUT,"AR")=ASUT(ASUT,"PT","AR")
- S ASUT(ASUT,"AR U/I")=""
- S ASUT(ASUT,"CALCED")=""
- S ASUT(ASUT,"CAN")=""
- S ASUT(ASUT,"CAT")="",ASUT(ASUT,"PT","CAT")=""
- S ASUT(ASUT,"CTG")=""
- S ASUT(ASUT,"UCS")=""
- S ASUT(ASUT,"DESC")=""
- S ASUT(ASUT,"BCD")=""
- S ASUT(ASUT,"DTD")=""
- S ASUT(ASUT,"DTE")=ASUK("DT","FM")
- S ASUT(ASUT,"DTS")=ASUK("DT","FM")
- S ASUT(ASUT,"DTX")=""
- S ASUT(ASUT,"DTW")=""
- S ASUT(ASUT,"DT IDX")=""
- S ASUT(ASUT,"DTP")=""
- S ASUT(ASUT,"DTR")=""
- S ASUT(ASUT,"ENTR BY")=DUZ
- S ASUT(ASUT,"EOQ TYP")="",ASUT(ASUT,"PT","EOQ TYP")="",ASUT(ASUT,"EOQ MM")="",ASUT(ASUT,"EOQ QM")="",ASUT(ASUT,"EOQ AM")=""
- S ASUT(ASUT,"FPN")=""
- S ASUT(ASUT,"IDX")="",ASUT(ASUT,"PT","IDX")=""
- S ASUT(ASUT,"LTM")=$FN($G(ASUL(1,"AR","DLTM")),"-",1)
- S ASUT(ASUT,"MST","QTY")="",ASUT(ASUT,"MST","VAL")=""
- S ASUT(ASUT,"NSN")=""
- S ASUT(ASUT,"ORD#")=""
- S ASUT(ASUT,"PST")=""
- S ASUT(ASUT,"PON")=""
- S ASUT(ASUT,"QTY")="",ASUT(ASUT,"QTY","REQ")="",ASUT(ASUT,"QTY","ISS")=""
- S ASUT(ASUT,"REQ")="",ASUT(ASUT,"PT","REQ")=""
- S ASUT(ASUT,"RPQ")=""
- S ASUT(ASUT,"REQ TYP")=1,ASUT(ASUT,"RQN")=""
- S ASUT(ASUT,"SLC")="",ASUT(ASUT,"PT","SLC")=""
- S ASUT(ASUT,"SOBJ")="",ASUT(ASUT,"PT","SOBJ")=""
- S ASUT(ASUT,"SPQ")=""
- S ASUT(ASUT,"SRC")="",ASUT(ASUT,"PT","SRC")=""
- S ASUT(ASUT,"SSA")="",ASUT(ASUT,"PT","SSA")=""
- S ASUT(ASUT,"SST")="",ASUT(ASUT,"PT","SST")=""
- S ASUT(ASUT,"PT","STA")=$G(ASUL(1,"AR","STA1")),ASUT(ASUT,"STA")=$E(ASUT(ASUT,"PT","STA"),4,5)
- S ASUT(ASUT,"STATUS")="Y"
- S ASUT(ASUT,"TRKY")=$G(ASUT(ASUT,"TRKY"))
- S ASUT(ASUT,"USR")="",ASUT(ASUT,"PT","USR")=""
- S ASUT(ASUT,"ULVQTY")=""
- S ASUT(ASUT,"VAL")=""
- S ASUT(ASUT,"VEN")="",ASUT(ASUT,"PT","VEN")="",ASUT(ASUT,"VEN NM")="",ASUT(ASUT,"SUI")=""
- S ASUT(ASUT,"VOU")=""
- M ASUJT=ASUT(ASUT)
- Q
- ASUJTRAN ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine will be used for transaction entry and review
- +3 ;Modified in ENTR to enable multiple can selection LMH 11/22/99
- +4 IF '$DATA(U)
- DO ^XBKVAR
- IF '$DATA(ASUK)
- DO ^ASUVAR
- IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIROUT))
- QUIT
- +5 IF $GET(ASUL(2,"STA","CD"))]""
- Begin DoDot:1
- +6 WRITE !!,"Data entry for Station: ",ASUL(2,"STA","NM")," - Code: ",ASUL(2,"STA","CD"),!
- End DoDot:1
- +7 IF '$TEST
- Begin DoDot:1
- +8 KILL DIR
- SET DIR(0)="P^9002039.02"
- SET DIR("A")="Enter Station Code"
- DO ^DIR
- +9 IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- IF Y<0
- QUIT
- +10 DO STA^ASULARST(Y)
- End DoDot:1
- IF '$DATA(ASUL(2))
- QUIT
- +11 WRITE !
- KILL DIR
- SET DIR(0)="SB^1:DUE IN;2:RECEIPT;3:ISSUE;4:INDEX;5:STATION;6:ADJUSTMENT;7:DIRECT ISSUE;8:TRANSFER ISSUE;9:BACKORDER CANCEL"
- SET DIR("A")="Enter Transaction Type"
- DO ^DIR
- +12 IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- +13 SET ASUJ=Y
- SET ASUT=$EXTRACT(Y(0),1,3)
- SET ASUJ("RTN")=$EXTRACT(ASUT,1,2)
- +14 GOTO @ASUJ
- +15 WRITE !,"Error - invalid transaction type entered"
- +16 QUIT
- 1 ;DUEIN
- +1 NEW DIR
- +2 SET DIR(0)="SB^12:PURCHASED;14:UNREQUIRED;15:DONATED;16:EXCESS;1K:CANCEL PURCHASED;1M:CANCEL UNREQUIRED;1N:CANCEL DONATED;1O:CANCEL EXCESS"
- +3 GOTO SELECT
- 2 ;RECEIPT
- +1 NEW DIR
- +2 SET ASUJ("RTN")="RC"
- +3 SET DIR(0)="SB^22:PURCHASED;24:UNREQUIRED;25:DONATED;26:EXCESS;2K:REVERSAL PURCHASED;2M:REVERSAL UNREQUIRED;2N:REVERSAL DONATED;1O:REVERSAL EXCESS"
- +4 GOTO SELECT
- 3 ;ISSUE
- +1 SET DIR(0)="SB^32:REPLENISHMENT;33:NON REPLENISHMENT;3K:REVERSAL REPLENISHMENT;3L:REVERSAL NON REPLENISHMENT"
- +2 GOTO SELECT
- 4 ;INDEX
- +1 SET ASUT="IDX"
- SET ASUJ("RTN")="IX"
- +2 SET DIR(0)="SB^4A:ADD;4C:CHANGE;4D:DELETE"
- +3 GOTO SELECT
- 5 ;STATION
- +1 SET DIR(0)="SB^5A:ADD;5B:USER LEVEL;5C:CHANGE;5D:DELETE"
- +2 GOTO SELECT
- 6 ;ADJUSTMENT
- +1 SET ASUJ("RTN")="AJ"
- +2 SET DIR(0)="SB^27:DEBIT;37:CREDIT;2K:REVERSAL DEBIT;3K:REVERSAL CREDIT"
- +3 GOTO SELECT
- 7 ;DIRECT ISSUE
- +1 SET DIR(0)="SB^02:PURCHASED;04:UNREQUIRED;05:DONATED;06:EXCESS;0K:REVERSAL PURCHASED;0M:REVERSAL UNREQUIRED;0N:REVERSAL DONATED;1O:REVERSAL EXCESS"
- +2 GOTO SELECT
- 8 ;TRANSFER ISSUE
- +1 SET ASUJ=3
- +2 SET DIR(0)="SB^34:UNREQUIRED;36:EXCESS;3M:REVERSAL UNREQUIRED;3O:REVERSAL EXCESS"
- +3 GOTO SELECT
- 9 ;BACKORDER CANCEL
- +1 SET ASUJ=3
- SET ASUT="CBO"
- SET ASUT("TRCD")="3J"
- SET ASUJ("RTN")="BO"
- +2 GOTO SELECTED
- SELECT ;SELECT TRANSATION CODE
- +1 WRITE !
- SET DIR("A")="Enter Transaction Code"
- DO ^DIR
- IF $DATA(DTOUT)
- QUIT
- IF $DATA(DUOUT)
- QUIT
- +2 SET ASUT("TRCD")=Y
- +3 IF $EXTRACT(ASUT("TRCD"))=4
- SET ASUT=$SELECT($EXTRACT(ASUT("TRCD"),2)="A":"XAD",$EXTRACT(ASUT("TRCD"),2)="C":"XCG",$EXTRACT(ASUT("TRCD"),2)="D":"XDL",1:"")
- +4 IF $EXTRACT(ASUT("TRCD"))=5
- SET ASUT=$SELECT($EXTRACT(ASUT("TRCD"),2)="A":"SAD",$EXTRACT(ASUT("TRCD"),2)="C":"SCG",$EXTRACT(ASUT("TRCD"),2)="D":"SDL",1:"STB")
- SELECTED ;EP ;
- +1 IF $GET(ASUJ("RTN"))=""
- SET ASUJ("RTN")=$EXTRACT($GET(ASUT),1,2)
- +2 SET ASUJ("RTN")=ASUJ_ASUJ("RTN")
- SET ASUF("TRAN")=0
- +3 DO ENTR
- +4 KILL ASUF("TRAN")
- QUIT
- ENTR ;EP - Call Screenman for transaction entry
- +1 IF $GET(ASUJ)=""!($GET(ASUT)="")!($GET(ASUT("TRCD")))=""
- QUIT
- +2 ;Q:$G(ASUJ)']"" Q:$G(ASUT)']"" Q:$G(ASUT("TRCD"))']""
- +3 SET ASUV("ASUT")=ASUT
- SET ASUV("TRCD")=ASUT("TRCD")
- SET ASUT("TYPE")=ASUJ
- +4 SET ASUJ("FILE")=9002036_"."_ASUJ
- +5 SET ASUJ("GLOB")="^ASUT("_ASUJ_","
- +6 SET ASUJ("TMPL")="[ASUJ"_ASUJ_$EXTRACT(ASUT,1,3)_"]"
- +7 SET ASUJ("WRIT")="S ASUF(""SV"")=1 D WRITE^ASU0TRWR(DA,.ASUJ)"
- +8 SET ASUJ("NEXT")="S DA=$O(^ASUT("_ASUJ_",9999999999),-1)+1"
- +9 ;WAR 4/30/99 prevents UPDT from being performed if need B
- SET ASUPOP=""
- +10 NEW Z
- SET Z=$GET(ASUT("TRCD"))
- DO TRN^ASULARST("T"_Z)
- SET ASUT(ASUT,"SIGN")=$GET(ASUL(11,"TRN","DRCR"))
- +11 IF $GET(ASUF("TRAN"))=0
- DO NEWTRAN
- +12 FOR ASUC("TRN")=0:1
- Begin DoDot:1
- +13 ;WAR 4/30/99
- IF ASUPOP
- SET ASUC("TRN")=ASUC("TRN")-1
- +14 SET ASUPOP=0
- +15 DO DUP
- SET ASUHDA=DA
- SET DDSFILE=ASUJ("FILE")
- SET DDSPARM="CES"
- SET DR=ASUJ("TMPL")
- +16 ;WAR 11/22/99
- IF ASUT("TRCD")["3"!(ASUT("TRCD")["0")
- SET ASUDDS=1
- +17 DO ^DDS
- +18 ;LMH 11/22/99 Reset ASUDDS
- SET ASUDDS=0
- +19 ;WAR 4/28/99 ASUPOP set in ASUJHELP
- IF $GET(DDSSAVE)=1&('ASUPOP)
- Begin DoDot:2
- +20 DO UPDT
- End DoDot:2
- +21 IF '$TEST
- Begin DoDot:2
- +22 SET DIK=ASUJ("GLOB")
- SET DA=ASUHDA
- DO ^DIK
- +23 ;REM'D WAR - 2/19/99 W !,"RECORD NOT SAVED!" D PAZ^ASUURHDR
- +24 SET DDSSAVE=0
- End DoDot:2
- End DoDot:1
- IF $GET(DDSSAVE)=0
- QUIT
- +25 WRITE !,$FNUMBER(ASUC("TRN"),",")," Records Entered during this session."
- +26 DO PAZ^ASUURHDR
- +27 KILL ASU("STARTING DA"),ASU("DA CNT")
- +28 KILL ASUC,ASUT,ASUJ,ASUJT,ASUMX,ASUMS,ASUMK,ASUV,ASUDDS
- +29 KILL ASUL(3),ASUL(7),ASUL(8),ASUL(9),ASUL(10),ASUL(11)
- +30 KILL ASUL(4),ASUL(5),ASUL(17),ASUL(18),ASUL(19),ASUL(20),ASUL(22)
- +31 QUIT
- UPDT ;EP ;Update masters
- +1 SET DDSSAVE=""
- +2 IF ASUJ=1
- DO ^ASU1DUPD
- QUIT
- +3 IF ASUJ=2
- DO ^ASU2RUPD
- QUIT
- +4 IF ASUJ=3
- Begin DoDot:1
- +5 IF ASUT("TRCD")="3J"
- DO BKORDCAN^ASU3BKOR
- QUIT
- +6 IF $EXTRACT(ASUT("TRCD"),2)?1N
- Begin DoDot:2
- +7 IF ASUT("TRCD")=32
- DO ^ASU3IUPD
- QUIT
- +8 IF ASUT("TRCD")=33
- DO ^ASU3IUPD
- QUIT
- +9 DO TXFIS^ASU3IUPD
- End DoDot:2
- +10 IF '$TEST
- Begin DoDot:2
- +11 DO RVIS^ASU3IUPD
- End DoDot:2
- End DoDot:1
- QUIT
- +12 IF ASUJ=4
- DO ^ASU4XUPD
- QUIT
- +13 IF ASUJ=5
- DO ^ASU5SUPD
- QUIT
- +14 IF ASUJ=6
- DO ^ASU6JUPD
- QUIT
- +15 IF ASUJ=7
- DO ^ASU7DUPD
- +16 QUIT
- DUP ;EP ;Duplicate data from transaction
- +1 SET ASUT=ASUV("ASUT")
- SET ASUT("TRCD")=ASUV("TRCD")
- DO DAYTIM^ASUUDATE
- SET ASUJT("TRKY")=$GET(ASUT(ASUT,"TRKY"))
- +2 MERGE ASUT(ASUT)=ASUJT
- +3 IF $GET(ASUT("TYPE"))']""
- SET ASUT("TYPE")=$GET(ASUJ)
- +4 XECUTE ASUJ("NEXT")
- +5 ;WAR 4/26/99 REM'D->S ASUF("SV")=1 X ASUJ("WRIT")
- +6 XECUTE ASUJ("WRIT")
- +7 FOR Z=3:1:10,12:1:22
- KILL ASUL(Z)
- +8 QUIT
- NEWTRAN ;
- +1 IF '$DATA(ASUL(1))
- DO SETAREA^ASULARST
- +2 IF '$DATA(DUZ)
- DO ^XBKVAR
- +3 SET ASUF("TRAN")=1
- +4 IF $GET(ASUT("TYPE"))']""
- SET ASUT("TYPE")=$GET(ASUJ)
- +5 SET ASUT=ASUV("ASUT")
- SET ASUT("TRCD")=ASUV("TRCD")
- +6 SET ASUT(ASUT,"ACC")=""
- SET ASUT(ASUT,"PT","ACC")=""
- +7 SET ASUT(ASUT,"PT","AR")=$GET(ASUL(1,"AR","AP"))
- SET ASUT(ASUT,"AR")=ASUT(ASUT,"PT","AR")
- +8 SET ASUT(ASUT,"AR U/I")=""
- +9 SET ASUT(ASUT,"CALCED")=""
- +10 SET ASUT(ASUT,"CAN")=""
- +11 SET ASUT(ASUT,"CAT")=""
- SET ASUT(ASUT,"PT","CAT")=""
- +12 SET ASUT(ASUT,"CTG")=""
- +13 SET ASUT(ASUT,"UCS")=""
- +14 SET ASUT(ASUT,"DESC")=""
- +15 SET ASUT(ASUT,"BCD")=""
- +16 SET ASUT(ASUT,"DTD")=""
- +17 SET ASUT(ASUT,"DTE")=ASUK("DT","FM")
- +18 SET ASUT(ASUT,"DTS")=ASUK("DT","FM")
- +19 SET ASUT(ASUT,"DTX")=""
- +20 SET ASUT(ASUT,"DTW")=""
- +21 SET ASUT(ASUT,"DT IDX")=""
- +22 SET ASUT(ASUT,"DTP")=""
- +23 SET ASUT(ASUT,"DTR")=""
- +24 SET ASUT(ASUT,"ENTR BY")=DUZ
- +25 SET ASUT(ASUT,"EOQ TYP")=""
- SET ASUT(ASUT,"PT","EOQ TYP")=""
- SET ASUT(ASUT,"EOQ MM")=""
- SET ASUT(ASUT,"EOQ QM")=""
- SET ASUT(ASUT,"EOQ AM")=""
- +26 SET ASUT(ASUT,"FPN")=""
- +27 SET ASUT(ASUT,"IDX")=""
- SET ASUT(ASUT,"PT","IDX")=""
- +28 SET ASUT(ASUT,"LTM")=$FNUMBER($GET(ASUL(1,"AR","DLTM")),"-",1)
- +29 SET ASUT(ASUT,"MST","QTY")=""
- SET ASUT(ASUT,"MST","VAL")=""
- +30 SET ASUT(ASUT,"NSN")=""
- +31 SET ASUT(ASUT,"ORD#")=""
- +32 SET ASUT(ASUT,"PST")=""
- +33 SET ASUT(ASUT,"PON")=""
- +34 SET ASUT(ASUT,"QTY")=""
- SET ASUT(ASUT,"QTY","REQ")=""
- SET ASUT(ASUT,"QTY","ISS")=""
- +35 SET ASUT(ASUT,"REQ")=""
- SET ASUT(ASUT,"PT","REQ")=""
- +36 SET ASUT(ASUT,"RPQ")=""
- +37 SET ASUT(ASUT,"REQ TYP")=1
- SET ASUT(ASUT,"RQN")=""
- +38 SET ASUT(ASUT,"SLC")=""
- SET ASUT(ASUT,"PT","SLC")=""
- +39 SET ASUT(ASUT,"SOBJ")=""
- SET ASUT(ASUT,"PT","SOBJ")=""
- +40 SET ASUT(ASUT,"SPQ")=""
- +41 SET ASUT(ASUT,"SRC")=""
- SET ASUT(ASUT,"PT","SRC")=""
- +42 SET ASUT(ASUT,"SSA")=""
- SET ASUT(ASUT,"PT","SSA")=""
- +43 SET ASUT(ASUT,"SST")=""
- SET ASUT(ASUT,"PT","SST")=""
- +44 SET ASUT(ASUT,"PT","STA")=$GET(ASUL(1,"AR","STA1"))
- SET ASUT(ASUT,"STA")=$EXTRACT(ASUT(ASUT,"PT","STA"),4,5)
- +45 SET ASUT(ASUT,"STATUS")="Y"
- +46 SET ASUT(ASUT,"TRKY")=$GET(ASUT(ASUT,"TRKY"))
- +47 SET ASUT(ASUT,"USR")=""
- SET ASUT(ASUT,"PT","USR")=""
- +48 SET ASUT(ASUT,"ULVQTY")=""
- +49 SET ASUT(ASUT,"VAL")=""
- +50 SET ASUT(ASUT,"VEN")=""
- SET ASUT(ASUT,"PT","VEN")=""
- SET ASUT(ASUT,"VEN NM")=""
- SET ASUT(ASUT,"SUI")=""
- +51 SET ASUT(ASUT,"VOU")=""
- +52 MERGE ASUJT=ASUT(ASUT)
- +53 QUIT