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

ASULDIRR.m

Go to the documentation of this file. 
  1. ASULDIRR ; IHS/ITSC/LMH -DIRECT LOOKUP REQUSITION RELATED ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine is a utility which provides entry points to lookup
  1.  ;entries in SAMS requsitioner related tables.
  1.  ;**SELCAN & MULTCAN subroutines created to enable mult. can lookup LMH 
  1. SST(X) ;EP ; DIRECT SUB STATION TABLE LOOKUP
  1.  I X["PL" S X=999
  1.  I $L(X)=3 S X=ASUL(1,"AR","AP")_X
  1.  I $L(X)=2 S X=ASUL(1,"AR","AP")_"0"_X
  1.  I X'?5N D  Q
  1.  .S Y=-4 Q  ;Input paramater did not pass Sub Station IEN edit
  1.  I $D(^ASUL(18,X,0)) D
  1.  .S (Y,ASUL(18,"SST","E#"))=X ;Record found for input parameter
  1.  .S ASUL(18,"SST")=$P($G(^ASUL(18,X,1)),U)
  1.  .S ASUL(18,"SST","NM")=$P($G(^ASUL(18,X,0)),U)
  1.  E  D
  1.  .S ASUL(18,"SST","E#")=X ;IEN to use for LAYGO call
  1.  .S ASUL(18,"SST")=$E(ASUL(18,"SST","E#"),4,5)
  1.  .S:'$D(ASUL(18,"SST","NM")) ASUL(18,"SST","NM")="UNKNOWN"
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. USR(X) ;EP ; DIRECT USER TABLE LOOKUP
  1. USRX ;
  1.  I '$G(ASUL(22,"PGM","E#")),X]"" D  Q:$G(Y)'=ASUL(22,"PGM","E#")
  1.  .S X(22)=$S(X'?6N:$E(X,1,2),1:$E(X,3,4)) S:X="00" X=100
  1.  .D PGM($E(X(22),1,2))
  1.  I $L(X)=3,X?2N.1AN S ASUL(19,"USR")=X D USR^ASULALGO(.X) Q:Y<0  ;Translate 3 digit user code to IEN
  1.  I $L(X)=4 S X=ASUL(1,"AR","AP")_X
  1.  I X'?6N D  Q
  1.  .S Y=-4 Q  ;Input paramater did not pass User IEN edit
  1.  I $D(^ASUL(19,X,0)) D
  1.  .S (Y,ASUL(19,"USR","E#"))=X ;Record found for input parameter
  1.  .S ASUL(19,"USR")=$P(^ASUL(19,X,1),U)
  1.  .S ASUL(19,"USR","NM")=$P(^ASUL(19,X,0),U)
  1.  E  D
  1.  .S ASUL(19,"USR","E#")=X ;IEN to use for LAYGO call
  1.  .I '$D(ASUL(19,"USR","NM")) S ASUL(19,"USR","NM")=$G(ASUL(22,"PGM","NM"))
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. REQ(X) ;EP ; DIRECT REQUISTIONER TABLE LOOKUP
  1.  I $G(ASUL(18,"SST","E#"))="" D  Q:$G(Y)<0
  1.  .I X?9N S ASUL(18,"SST","E#")=$E(X,1,5) Q
  1.  .S Y=-10 ;Must have Sub Station
  1.  I $G(ASUL(18,"SST"))="" S X(1)=ASUL(18,"SST","E#") D SST(X(1))
  1.  I $G(ASUL(19,"USR","E#"))="" D  Q:Y'=$G(ASUL(19,"USR","E#"))
  1.  .I X?9N S X(1)=X,(X,ASUL(19,"USR","E#"))=$E(X(1),1,2)_$E(X(1),6,9) D USR(X) S X=X(1) Q
  1.  .D USRX
  1.  I $G(ASUL(19,"USR"))="" S X(1)=ASUL(19,"USR","E#") D USR(X(1))
  1.  S X=ASUL(18,"SST","E#")_$E(ASUL(19,"USR","E#"),3,6)
  1.  I X'?9N D  Q
  1.  .S Y=-4 Q  ;Input paramater did not pass User IEN edit
  1.  S ASUL(20,"REQ")=ASUL(19,"USR")
  1.  I $D(^ASUL(20,X,0)) D
  1.  .S (Y,ASUL(20,"REQ","E#"))=X ;Record found for input parameter
  1.  .S ASUL(20,"REQ","NM")=$P(^ASUL(20,X,0),U)
  1.  .S ASUL(20,"ULVQ FCTR")=$P($G(^ASUL(20,X,1)),U)
  1.  .N Z S Z=0
  1.  .;F ASUC("SSA")=1:1 S Z=$O(^ASUL(20,ASUL(20,"REQ","E#"),2,"C",Z)) I ASUC("SSA")>1 D MULTCAN K ASUC("SSA"),ASUL("SSA") Q  Q:Z=""  D
  1.  .F ASUC("SSA")=1:1 S Z=$O(^ASUL(20,ASUL(20,"REQ","E#"),2,"C",Z)) Q:Z=""  D
  1.  ..S ASUL(20,"SSA")=Z,ASUL(20,"SSA","CNT")=ASUC("SSA")
  1.  ..S ASUL("SSA","E#")=$O(^ASUL(20,ASUL(20,"REQ","E#"),2,"C",ASUL(20,"SSA"),0))
  1.  ..S ASUL(20,"CAN",ASUL(20,"SSA"))=$P(^ASUL(20,ASUL(20,"REQ","E#"),2,ASUL("SSA","E#"),0),U)
  1.  .I $G(ASUL(20,"SSA","CNT"))>1 D MULTCAN  ;WAR 11/26/99 
  1.  .K ASUC("SSA"),ASUL("SSA")
  1.  E  D
  1.  .S ASUL(20,"REQ","E#")=X ;IEN to use for LAYGO call
  1.  .S ASUL(20,"ULVQ FCTR")=""
  1.  .S ASUL(20,"REQ","NM")=ASUL(19,"USR","NM")_" @ "_ASUL(18,"SST","NM")
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1.  ;
  1. MULTCAN ; Allows selection of multiple CANs
  1.  ;
  1.  I $G(ASUDDS)=1 D
  1.  .S DA(1)=ASUL(20,"REQ","E#")
  1.  .S DIC="^ASUL(20,"_DA(1)_",2,"
  1.  .S DIC(0)="AEMQL"
  1.  .I ASUT("TRCD")["0" W !!!! S DIC("A")="Enter a ""??"" and select a CAN: "
  1.  .W !!!! S DIC("A")="Enter a ""??"" and select a CAN: "
  1.  .D ^DIC
  1.  .I +$G(Y)>0 D SELCAN
  1.  Q
  1.  ;
  1. SELCAN ; If there are multiple CANs, uses selection for transaction  
  1.  ;
  1.  S ASUL("SSA","E#")=+Y
  1.  S ASUL(20,"SSA")=$P(^ASUL(20,ASUL(20,"REQ","E#"),2,ASUL("SSA","E#"),0),U,2)
  1.  S ASUL(20,"CAN",ASUL(20,"SSA"))=$P(^ASUL(20,ASUL(20,"REQ","E#"),2,ASUL("SSA","E#"),0),U)
  1.  K ASUC("SSA"),ASUL("SSA")
  1.  Q
  1. SSA(X) ;EP ; DIRECT SUB-SUB ACTVITY TABLE LOOKUP
  1.  I X'?1N.N D
  1.  .S Y=-4 Q  ;Input paramater did not pass Sub-sub activity IEN edit
  1.  S:+X=0 X=100
  1.  I $D(^ASUL(17,+X,0)) D
  1.  .S (Y,ASUL(17,"SSA","E#"))=+X ;Record found for input parameter
  1.  .S ASUL(17,"SSA")=$P(^ASUL(17,+X,1),U)
  1.  .S ASUL(17,"SSA","NM")=$P(^ASUL(17,+X,0),U)
  1.  E  D
  1.  .S ASUL(17,"SSA","E#")=+X ;IEN to use for LAYGO call
  1.  .S ASUL(17,"SSA")="N/F"
  1.  .S ASUL(17,"SSA","NM")="UNKNOWN"
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. PGM(X) ;EP ; DIRECT PROGRAM TABLE LOOKUP
  1. PGMX ;
  1.  I +X=0 S X=100
  1.  I $D(^ASUL(22,+X,0)) D
  1.  .S (Y,ASUL(22,"PGM","E#"))=+X ;Record found for input parameter
  1.  .S ASUL(22,"PGM")=$P(^ASUL(22,+X,0),U)
  1.  .S ASUL(22,"PGM","NM")=$P(^ASUL(22,+X,0),U,2)
  1.  E  D
  1.  .I X="" S Y=-2 Q
  1.  .S ASUL(22,"PGM","E#")=+X ;IEN to use for LAYGO call
  1.  .S ASUL(22,"PGM")="N/F"
  1.  .S ASUL(22,"PGM","NM")="UNKNOWN"
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. SLC(X) ;EP;.
  1.  S:X]"" ASUL(10,"SLC","E#")=$O(^ASUL(10,"B",X,""))
  1.  I $G(ASUL(10,"SLC","E#"))="" S ASUL(10,"SLC","NM")="UNKNOWN",ASUL(10,"SLC")=" ",ASUL(10,"SLC","E#")="" Q
  1.  S ASUL(10,"SLC","NM")=$P(^ASUL(10,ASUL(10,"SLC","E#"),0),U,2)
  1.  S ASUL(10,"SLC")=X
  1.  Q