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

ASULDIRF.m

Go to the documentation of this file. 
  1. ASULDIRF ; IHS/ITSC/LMH -DIRECT LKUP FINANCE 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 finance related tables.
  1. ACC(X) ;EP ; DIRECT ACCOUNT TABLE LOOKUP
  1.  I $D(^ASUL(9,+X,0)) D
  1.  .S (Y,ASUL(9,"ACC","E#"))=+X ;Record found for input parameter
  1.  .S ASUL(9,"ACC")=$P(^ASUL(9,+X,0),U,2)
  1.  .S ASUL(9,"ACC","NM")=$P(^ASUL(9,+X,0),U)
  1.  .S ASUL(9,"ACG")=$S(ASUL(9,"ACC")=1:1,ASUL(9,"ACC")=3:3,1:"*") D ACGNM(ASUL(9,"ACG"))
  1.  E  I X  D   ;IHS/DSD/JLG 5/6/99  Modified to only apply if X is true
  1.  .S ASUL(9,"ACC","E#")=+X ;IEN to use for LAYGO call
  1.  .S (ASUL(9,"ACC"),ASUL(9,"ACG"))="N/F"
  1.  .S (ASUL(9,"ACC","NM"),ASUL(9,"ACG","NM"))="UNKNOWN"
  1.  .S Y=-1 ;No record found for Input parameter
  1.  E  D
  1.  .;If X is not a valid ien value set the flag and make sure there is
  1.  .;no left over values for the ASUL array.  It is possible this will not
  1.  .;work out and may require something else to be done.
  1.  .S Y=-1  ;X is not a valid ien
  1.  .K ASUL(9,"ACC")
  1.  Q
  1. ACGNM(X) ;EP ; SET ACCOUNT GROUP NAME
  1.  S:$G(ASUL(9,"ACG"))']"" ASUL(9,"ACG")=X
  1.  I X="*" S ASUL(9,"ACG","NM")="GENERAL SUPPLIES" Q
  1.  S ASUL(9,"ACG","NM")=$P(^ASUL(9,+X,0),U)
  1.  Q
  1. SOBJ(X) ;EP
  1.  D SSO(.X)
  1.  Q
  1. SSO(X) ;EP ; STOCK SUB OBJECT TABLE LOOKUP
  1.  ;Format of IEN: 1st digit=Account
  1.  ;               digit 2-3 = digit 3-4 of Sub Object Code
  1.  ;I (X?4N)!(X?1A.AN) D OBJ(3) I Y>0 S X=+Y
  1.  D OBJ(3) I Y>0 S X=+Y
  1.  I X']"" S Y=-10 K ASUL(3) Q
  1.  I '$G(ASUL(9,"ACC","E#")) D
  1.  .I $L(X)=3 D  Q:$G(Y)<0
  1.  ..S X(1)=$E(X) D ACC(X(1)) K:Y<0 ASUL(3)
  1.  E  D  Q:$G(Y)<0
  1.  .;I ASUT("E#")=13 B
  1.  .I $L(X)=3 D  Q:$G(Y)<0
  1.  ..I ASUL(9,"ACC","E#")'=$E(X) S Y=-11 K ASUL(3) Q
  1.  I X[".",$L(X)=5 S X=$E(X,5)
  1.  I $L(X)=4 S X=$E(X,4)
  1.  I $L(X)=1 D TR^ASULALGO(.X) S:Y>0 X=$G(ASUL(9,"ACC","E#"))_Y
  1.  I $L(X)=3,$D(^ASUL(3,X,0)) D
  1.  .S (Y,ASUL(3,"SOBJ","E#"))=X
  1.  .S ASUL(3,"SOBJ","ACC")=ASUL(9,"ACC","E#")
  1.  .S ASUL(3,"SOBJ","NM")=$P(^ASUL(3,Y,0),U)
  1.  .S X=$P(^ASUL(3,Y,1),U),ASUL(3,"SOBJ","CD")=$E(X,1,2)_"."_$E(X,3,4)
  1.  E  D
  1.  .S ASUL(3,"SOBJ","NM")="UNKNOWN",ASUL(3,"SOBJ","CD")="NF",ASUL(3,"SOBJ","ACC")=""
  1.  .S Y=-1
  1.  Q
  1. OBJ(Z) ;
  1.  S DIC="^ASUL("_Z_",",DIC(0)="MS" D ^DIC
  1.  ;I ASUT("E#")=13 B
  1.  Q
  1. DSO(X) ;EP ; DIRECT SUB OBJECT TABLE LOOKUP
  1.  ;Format of IEN: 1st digit=Account
  1.  ;               digit 2-3 = digit 3-4 of Sub Object Code
  1.  ;I (X?4N)!(X?1A.AN) D OBJ(4) I Y>0 S X=+Y
  1.  D OBJ(4) I Y>0 S X=+Y
  1.  I X']"" S Y=-10 K ASUL(4) Q
  1.  I '$G(ASUL(9,"ACC","E#")) D
  1.  .I $L(X)=3 D  Q:$G(Y)<0
  1.  ..S X(1)=$E(X) D ACC(X(1)) K:Y<0 ASUL(4)
  1.  E  D  Q:Y<0
  1.  .I $L(X)=3 D  Q:$G(Y)<0
  1.  ..I ASUL(9,"ACC","E#")'=$E(X) S Y=-11 K ASUL(4) Q
  1.  I X[".",$L(X)=5 S X=$E(X,5)
  1.  I $L(X)=4 S X=$E(X,4)
  1.  I $L(X)=1 D TR^ASULALGO(.X) S:Y>0 X=$G(ASUL(9,"ACC","E#"))_Y
  1.  I $L(X)=3,$D(^ASUL(4,X,0)) D
  1.  .S (Y,ASUL(4,"SOBJ","E#"))=X,ASUL(4,"SOBJ","ACC")=ASUL(9,"ACC","E#")
  1.  .S ASUL(4,"SOBJ","NM")=$P(^ASUL(4,X,0),U)
  1.  .S X=$P(^ASUL(4,Y,1),U),ASUL(4,"SOBJ","CD")=$E(X,1,2)_"."_$E(X,3,4)
  1.  E  D
  1.  .S ASUL(4,"SOBJ","NM")="UNKNOWN",ASUL(4,"SOBJ","CD")="NF",ASUL(4,"SOBJ","ACC")=""
  1.  .S Y=-1
  1.  Q
  1. DCAN(X) ;EP ; DIRECT ISSUE COMMON ACCOUNTING NUMBER
  1.  Q
  1. SRC(X) ;EP ; DIRECT SOURCE TABLE LOOKUP
  1.  ;I X?1AN D TR^ASULALGO(.X)
  1.  ;I X?2N,$D(^ASUL(5,X,0)) D
  1.  S Y=$O(^ASUL(5,"C",X,"")) I Y D
  1.  .S ASUL(5,"SRC","E#")=Y ;Record found for input parameter
  1.  .S ASUL(5,"SRC","NM")=$P(^ASUL(5,Y,0),U),ASUL(5,"SRC")=$P(^(0),U,2)
  1.  E  D
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. CAT(X) ;EP ; DIRECT CATEGORY TABLE LOOKUP
  1.  ;Format of IEN - digits1-3 = IEN of Stock Sub Object (ASUL(3))
  1.  ;                digits4-5 = Algolrythm of Category Code
  1.  ;                ie 1=01,2=02,A=10,B=11
  1.  I $G(ASUL(3,"SOBJ","E#"))']"" D  Q:Y<0
  1.  .I X?5N S ASUL(3,"SOBJ","E#")=$E(X,1,3)
  1.  E  D
  1.  .K ASUL(7) S Y=-10 Q  ;Must have Stock Sub Object
  1.  I $G(ASUL(3,"SOBJ","CD"))']"" S X(1)=ASUL(3,"SOBJ","E#") D SSO(X(1))
  1.  I X?1AN D TR^ASULALGO(.X) S:Y>0 X=ASUL(3,"SOBJ","E#")_Y
  1.  I X'?5N D  Q
  1.  .S Y=-4 Q  ;Input paramater did not pass User IEN edit
  1.  I $D(^ASUL(7,X,0)) D
  1.  .S (Y,ASUL(7,"CAT","E#"))=X ;Record found for input parameter
  1.  .S ASUL(7,"CAT","NM")=$P(^ASUL(7,X,0),U)
  1.  .S ASUL(7,"CAT","CD")=$P(^ASUL(7,X,1),U)
  1.  E  D
  1.  .S ASUL(7,"CAT","E#")=X ;IEN to use for LAYGO call
  1.  .S Y=-1 ;No record found for Input parameter
  1.  Q
  1. EOQT(X) ;EP ; DIRECT EOQ TABLE LOOKUP
  1.  S ASUL(8,"EOQTB","E#")=X,Y=0
  1.  I $D(^ASUL(8,X))'>0 S Y=-1 Q
  1.  F  S Y=$O(^ASUL(8,X,1,Y)) Q:Y']""  D
  1.  .S ASUL(8,"EOQTB",Y)=^ASUL(8,X,1,Y,0)
  1.  Q
  1. EOQ(X) ;EP ; DIRECT EOQ TYPE LOOKUP
  1.  S Y=0
  1.  I X?1A D
  1.  .S ASUL(6,"EOQTP","E#")=$O(^ASUL(6,"B",X,""))
  1.  E  D
  1.  .S ASUL(6,"EOQTP","E#")=X
  1.  I ASUL(6,"EOQTP","E#")'?1N.N S Y=-1 Q
  1.  I $D(^ASUL(6,ASUL(6,"EOQTP","E#")))'>0 S Y=-2 Q
  1.  S ASUL(6,"EOQTP")=$P($G(^ASUL(6,ASUL(6,"EOQTP","E#"),0)),U)
  1.  S ASUL(6,"EOQTP","NM")=$P($G(^ASUL(6,ASUL(6,"EOQTP","E#"),0)),U,2)
  1.  Q