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

ASUJBTCH.m

Go to the documentation of this file. 
  1. ASUJBTCH ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ;  [ 07/17/2000  9:10 AM ]
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine will be used to process transactions already entred
  1.  D:'$D(U) ^XBKVAR D:'$D(ASUK) ^ASUVAR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
  1.  I $G(ASUL(1,"AR","STA1"))]"" D
  1.  .D STA^ASULARST(ASUL(1,"AR","STA1"))
  1.  .W !!,"Process transactions for Station: ",ASUL(2,"STA","NM")," - Code: ",ASUL(2,"STA","CD"),!
  1.  S ASUSB=1
  1.  F ASUJ=4,5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Add transactions" D
  1.  .D PTRSET(ASUJ)
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUT("TRCD")["A"  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  F ASUJ=4,5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Change transactions" D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUT("TRCD")["C"  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  F ASUJ=5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Station User Level Change transactions" D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUT("TRCD")["B"  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  F ASUJ=1,2,3,6,7 D PTRSET(ASUJ)
  1.  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
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUJ1="2T",ASUL(11,"TRN","TYPE")'=8 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  ...I ASUJ1="3T",ASUL(11,"TRN","TYPE")'=9 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  ...I ASUT(ASUT,"SIGN")=1  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  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
  1.  .I ASUJ1="3T"
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUJ1="2T",ASUL(11,"TRN","TYPE")'=8 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  ...I ASUJ1="3T",ASUL(11,"TRN","TYPE")'=9 S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  ...I ASUJ1="3I",ASUT(ASUT,"PST")'="I" S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  ...I ASUT(ASUT,"SIGN")=-1  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  F ASUJ=5,4 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Delete transactions" D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) S ASUC("TRN")=0 D DCOUNT Q
  1.  .F ASUC("TRN")=0:1 S ASUV("E#")=$O(^ASUT(ASUJ,"C","Y",ASUV("E#"))) Q:ASUV("E#")']""  D
  1.  ..S ASUT=0,ASUHDA=ASUV("E#") D TRRD Q:$G(ASUT)']""  D
  1.  ...I ASUT("TRCD")["D"  D
  1.  ....D UPDT
  1.  ...E  D
  1.  ....S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .D DCOUNT
  1.  W !!,$FN(ASUC("TOT"),",")," Total Records processed."
  1.  K ASUC,ASUT,ASUJ,ASUMX,ASUMS,ASUMK,ASUV
  1.  Q
  1. DCOUNT ;
  1.  W !?15," Count=",$J($FN(ASUC("TRN"),","),10) S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN")
  1.  Q
  1. UPDT ;EP ;Update masters
  1.  S ASUJ("RTN")=ASUJ_$E($G(ASUT),1,2)
  1.  I $G(ASUJ)']""!($G(ASUT)']"")!($G(ASUT("TRCD"))']"") S ASUC("TRN")=$G(ASUC("TRN"))-1 Q
  1.  S ASUV("ASUT")=ASUT,ASUV("TRCD")=ASUT("TRCD")
  1.  S ASUJ("FILE")=9002036_"."_ASUJ
  1.  S ASUJ("GLOB")="^ASUT("_ASUJ_","
  1.  S DIE="9002036."_ASUJ,DA=ASUHDA
  1.  W !?5,ASUHDA," ",ASUT("TRCD"),$J($G(ASUT(ASUT,"IDX")),8),$J($G(ASUT(ASUT,"VOU")),12),!," Editing:"
  1.  D CKFLD
  1.  I $G(DDSSAVE)=1 D
  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 $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.  E  D
  1.  .I $G(E)=0 Q
  1.  .D MREJ K E,DDSERROR S DDSSAVE=0,DDSERROR=99
  1.  I $G(ASUF("ERR"))>0 S DDSSAVE=0,DDSERROR=ASUF("ERR")
  1.  E  S DDSSAVE=1
  1.  I $G(DDSSAVE)=1 W " UDOK"
  1.  E  W " NOUD" Q:DDSERROR=99  D MREJ
  1.  S DDSSAVE=0 K E,Z,DDSERROR,ASUF("ERR")
  1.  Q
  1. MREJ ;
  1.  S X=ASUJ("GLOB")_ASUHDA_")" M ^ASUTR(ASUJ,ASUHDA)=@(X)
  1.  W !?5,"Reject/move to ^ASUTR ERR=",$G(DDSERROR)
  1.  S DIK=ASUJ("GLOB"),DA=ASUHDA D ^DIK
  1.  Q
  1. TRRD ;EP ;Read transactions
  1.  D READ^ASU0TRRD(.ASUHDA,.ASUJ) Q
  1.  Q
  1. PTRSET(F) ;
  1.  N C,R
  1.  S R=0 F C=1:1 S R=$O(^ASUT(F,R)) Q:R'?1N.N  D
  1.  .D READ^ASU0TRRD(R,F)
  1.  .D WRITE^ASU0TRWR(R,F)
  1.  Q
  1. CKFLD ;EP ;Validate fields for batch processing
  1.  ;N E I ASUT(ASUT,"AR")=ASUL(1,"AR","AP"),ASUT(ASUT,"STA")=ASUL(2,"STA","CD") D
  1.  N E I ASUT(ASUT,"AR")=ASUL(1,"AR","AP") D
  1.  .D @(ASUJ)
  1.  .I $G(E)>0 D
  1.  ..S DDSSAVE=0 W " EDBD"
  1.  .E  D
  1.  ..S DDSSAVE=1 W " EDOK"
  1.  E  D
  1.  .W " Transaction not for YOUR Area/Station - Not Edited" S DDSSAVE=0,E=0
  1.  Q
  1. 1 ;Due in validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^IDX","R^PON","R^QTY","R^VAL" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="R",P="R^SSA" D VLD(.P) Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. 2 ;Receipt validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^VOU",$S(ASUT("TRCD")=22:"R",1:"")_"^PON","R^QTY","R^VAL","R^FPN" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="R",P="R^SSA" D VLD(.P) Q:$G(E)>0
  1.  S M="F",P="R^SRC" D VLD(.P) Q:$G(E)>0
  1.  S M="D" F P="^DTX","R^DTE" D VLD(.P) Q:$G(E)>0
  1.  Q
  1. 3 ;Issue validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^IDX","R^VOU","^PST","R^QTYR",$S($E(ASUT("TRCD"),2)=2:"R",1:"")_"^FPN","^RTP" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="R" F P="R^SST","R^USR" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="AN" F F="^CTG","^RQN" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. 4 ;Index validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^IDX","A^NSN" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="F" F P="C^ACC","A^SSO","A^CAT" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="N",P="^BCD" D VLD(.P) Q:$G(E)>0
  1.  S M="A",P="^AUI" D VLD(.P) Q:$G(E)>0
  1.  S M="A",P="A^DESC" D VLD(.P) Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. 5 ;Station validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^IDX","^VEN","^ORD","A^EOQ" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="F",P="A^SRC" D VLD(.P) Q:$G(E)>0
  1.  S M="R",P="^SLC" D VLD(.P) Q:$G(E)>0
  1.  I ASUT("TRCD")="5B" D  Q:$G(E)>0
  1.  .S M="R" F P="R^SST","R^USR" D VLD(.P) Q:$G(E)>0
  1.  .S M="N",P="R^ULQ" D VLD(.P)
  1.  S M="A",P="^SUI" D VLD(.P) Q:$G(E)>0
  1.  S M="N" F P="A^UCS","^LTM","^SPQ","A^RPQ" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. 6 ;Adjustment validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="R^IDX","R^VOU" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="N" F P="^QTY","^VAL" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. 7 ;Direct Issue validation
  1.  N F,M,P,R,X
  1.  S M="E" F P="^PON","R^VOU" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="R" F P="R^SST","R^USR" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="F" F P="R^ACC","R^DSO","^SRC" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="N" F P="R^QTY","R^VAL" D VLD(.P) Q:$G(E)>0
  1.  Q:$G(E)>0
  1.  S M="D",P="R^DTE" D VLD(.P)
  1.  Q
  1. VLD(P) ;
  1.  S F=$P(P,U,2),R=$P(P,U) I R="A" S R=$S($E(ASUT("TRCD"),2)="A":"R",1:"")
  1.  S X=$G(ASUT(ASUT,$S(F="SSO":"SOBJ",F="DSO":"SOBJ",F="EOQ":"EOQ TYP",1:F)))
  1.  I F="QTYR" S X=ASUT(ASUT,"QTY","REQ")
  1.  I X']"" D  Q
  1.  .I R="R" S E="1^"_F_" a required field is null" W " #",$P(E,U,2),! Q
  1.  .W " *",F
  1.  D VLDF(.M,.F,.X)
  1.  Q
  1. VLDF(M,F,X) ;Validate and save field
  1.  N Z I $G(ASUSB)=1 W " ",F
  1.  I ASUJ<7,ASUT("TRCD")'="4A",$G(ASUT(ASUT,"PT","IDX"))]"" S ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX") D ^ASUMXDIO
  1.  I ASUJ<7,ASUJ'=4,ASUT("TRCD")'="5A",$G(ASUT(ASUT,"PT","STA"))]"",$G(ASUMS("E#","IDX"))]"",$G(^ASUMX(ASUMS("E#","IDX"),0)) S ASUMS("E#","STA")=$G(ASUL("ST#")) D ^ASUMSTRD
  1.  S DDSERROR=""
  1.  ;I $G(ASUMS("E#","IDX"))&'$G(^ASUMX(ASUMS("E#","IDX"),0)) S M="E"  ;CSC
  1.  I M="E" D
  1.  .S Z="D "_F_"^ASUJVALF(.X,.DDSERROR)" X Z
  1.  E  D
  1.  .S Z="D EN^ASUJVALD(.X,.DDSERROR,.F,.M)" X Z
  1.  S E=$G(DDSERROR)
  1.  Q