Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASUJTRAN

ASUJTRAN.m

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