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

ASUBTCH.m

Go to the documentation of this file. 
  1. ASUBTCH ; IHS/ITSC/LMH -SCREENMAN FOR DATA ENTRY ; 
  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 PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN")-1 D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  F ASUJ=4,5 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Change transactions" D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  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
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  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 PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  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 PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .I ASUJ1="3T"
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  F ASUJ=5,4 W !,"Processing ",$P(^ASUT(ASUJ,0),U)," Master Delete transactions" D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)  D
  1.  .S ASUV("E#")=0 I '$D(^ASUT(ASUJ,"C","Y")) W !,"None entered" 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 UPDT
  1.  ...E  S ASUC("TRN")=$G(ASUC("TRN"))-1
  1.  .W " Count=",$FN(ASUC("TRN"),",") S ASUC("TOT")=$G(ASUC("TOT"))+ASUC("TRN") D PAZ^ASUURHDR Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  W !!,$FN(ASUC("TOT"),",")," Total Records processed." D PAZ^ASUURHDR
  1.  K ASUC,ASUT,ASUJ,ASUMX,ASUMS,ASUMK,ASUV
  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 ASUJ("TMPL")="[ASUJ"_ASUJ_$E(ASUT,1,3)_"]"
  1.  S DIE="9002036."_ASUJ,DA=ASUHDA,DDSFILE=ASUJ("FILE"),DDSPARM="CES",DR=ASUJ("TMPL")
  1.  D ^DDS
  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.  .S DIK=ASUJ("GLOB"),DA=ASUHDA D ^DIK
  1.  .S DDSSAVE=0
  1.  Q
  1. TRRD ;EP ;Read transactions
  1.  D READ^ASU0TRRD(.ASUHDA,.ASUJ) Q
  1.  Q
  1. CKFLD ;EP ;Validate fields for batch processing
  1.  D @(ASUJ)
  1.  Q
  1. 1 ;Due in validation
  1.  N F,M,X S M="E" F F="IDX","PON","QTY","VAL" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="R" S F="SSA" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 2 ;Receipt validation
  1.  N F,M,X S M="E" F F="VOU","PON","QTY","VAL","FPN" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="R" S F="SSA" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="F" S F="SRC" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D" F F="DTX","DTE" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 3 ;Issue validation
  1.  N F,M,X S M="E" F F="IDX","VOU","FPN","PST","QTYR","RTP" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="R" F F="SST","USR" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  ;S M="F",F="SRC",X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  ;S M="N" S F="VAL" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="AN" F F="CTG","RQN" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D",F="DTE",X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 4 ;Index validation
  1.  N F,M,X S M="E" F F="NSN" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="F" F F="ACC","SSO","CAT" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="N" S F="BCD" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="A" S F="AUI" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="AN" F F="DESC","CTG" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 5 ;Station validation
  1.  N F,M,X S M="E" F F="IDX","STA","VEN","ORD","EOQ" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="R" F F="SST","USR" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="A" S F="SUI" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="N" F F="UCS","LTM","SPQ","RPQ","ULQ" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 6 ;Adjustment validation
  1.  N F,M,X S M="E" F F="IDX","VOU" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="N" F F="QTY","VAL" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="D" S F="DTE" S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. 7 ;Direct Issue validation
  1.  N F,M,X S M="E" F F="PON","VOU" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="R" F F="SST","USR" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="F" F F="ACC","DSO","SRC" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  S M="N" F F="QTY","VAL" D
  1.  .S X=$G(ASUT(ASUT,F)) Q:X']""  D VAL(.M,.F,.X)
  1.  Q
  1. VAL(M,F,X) ;Validate and save field
  1.  N Z
  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"))]"" S ASUMS("E#","STA")=$G(ASUL("ST#")) D ^ASUMSTRD
  1.  I M="E" S Z="D "_F_"^ASUJVALF(.X,.DDSERROR)" X Z Q
  1.  S Z="D EN^ASUJVALD(.X,.DDSERROR,.F,.M)" X Z Q
  1.  Q