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

ASUMYDIO.m

Go to the documentation of this file. 
  1. ASUMYDIO ; IHS/ITSC/LMH -YTD ISSUE DATA MASTER I/O ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;This routine is a utility routine which provides an entry point to
  1.  ;;read (retreve) data from the SAMS YTD Issue Data Master file.
  1.  ;;(in global ^ASUMY & VA Fileman file ASUMST YTD ISSUE DATA).
  1. READ ;EP; TO SET YEAR TO DATE ISSUE DATA FIELDS
  1.  I '$D(ASUMY("E#","REQ")) Q
  1.  S ASUMY("E#","USR")=$P(^ASUL(20,ASUMY("E#","REQ"),0),U,2)
  1.  S ASUMY("USR")=$P(^ASUL(19,ASUMY("E#","USR"),1),U)
  1.  S ASUMY("USR","NM")=$P(^ASUL(19,ASUMY("E#","USR"),0),U)
  1.  S ASUMY("E#","PGM")=+($P(^ASUL(19,ASUMY("E#","USR"),0),U,3))
  1.  I ASUMY("E#","PGM")'>0 D
  1.  .S ASUMY("PGM")=$E(ASUMY("USR"),1,2),ASUMY("PGM","NM")="UNKNOWN"
  1.  E  D
  1.  .S ASUMY("PGM")=$P(^ASUL(22,ASUMY("E#","PGM"),0),U)
  1.  .S ASUMY("PGM","NM")=$P(^ASUL(22,ASUMY("E#","PGM"),0),U,2)
  1.  S ASUMY(0,"REQ")=$G(^ASUMY(ASUMY("E#","REQ"),0))
  1.  S ASUMY("E#","SST")=$P(^ASUL(20,ASUMY("E#","REQ"),0),U,3)
  1.  S ASUMY("SST")=$P(^ASUL(18,ASUMY("E#","SST"),1),U)
  1.  S ASUMY("SST","NM")=$P(^ASUL(18,ASUMY("E#","SST"),0),U)
  1.  I '$D(ASUMY("E#","SSA")) Q
  1.  S ASUMY("SSA")=$P(^ASUL(17,ASUMY("E#","SSA"),1),U)
  1.  S ASUMY("SSA","NM")=$P(^ASUL(17,ASUMY("E#","SSA"),0),U)
  1.  S ASUMY(0,"SSA")=$G(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),0))
  1.  I '$D(ASUMY("E#","ACC")) Q
  1.  S ASUMY(0)=$G(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),1))
  1.  I $D(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),0)) D
  1.  .S ASUMY("ACC")=$P(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),0),U)
  1.  E  D
  1.  .S (ASUMY("ACC"),^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),0))=ASUMY("E#","ACC")
  1.  S ASUMY("CMO","RCR","VAL")=$P(ASUMY(0),U)
  1.  S ASUMY("YTD","RCR","VAL")=$P(ASUMY(0),U,2)
  1.  S ASUMY("YTD","NRC","VAL")=$P(ASUMY(0),U,3)
  1.  S ASUMY("CMO","DIR","VAL")=$P(ASUMY(0),U,4)
  1.  S ASUMY("YTD","DIR","VAL")=$P(ASUMY(0),U,5)
  1.  S ASUMY("CMO","SCH","LI")=$P(ASUMY(0),U,6)
  1.  S ASUMY("YTD","SCH","LI")=$P(ASUMY(0),U,7)
  1.  S ASUMY("CMO","SCH","DOC")=$P(ASUMY(0),U,8)
  1.  S ASUMY("YTD","SCH","DOC")=$P(ASUMY(0),U,9)
  1.  S ASUMY("CMO","USC","LI")=$P(ASUMY(0),U,10)
  1.  S ASUMY("YTD","USC","LI")=$P(ASUMY(0),U,11)
  1.  S ASUMY("CMO","USC","DOC")=$P(ASUMY(0),U,12)
  1.  S ASUMY("YTD","USC","DOC")=$P(ASUMY(0),U,13)
  1.  S ASUMY("IS0","LI")=$P(ASUMY(0),U,14)
  1.  S ASUMY("ISP","LI")=$P(ASUMY(0),U,15)
  1.  S ASUMY("B/O","LI")=$P(ASUMY(0),U,16)
  1.  S ASUMY("QTYADJ","LI")=$P(ASUMY(0),U,17)
  1.  S ASUMY("CMO","DIR","LI")=$P(ASUMY(0),U,18)
  1.  S ASUMY("YTD","DIR","LI")=$P(ASUMY(0),U,19)
  1.  S ASUMY("CMO","DIR","DOC")=$P(ASUMY(0),U,20)
  1.  S ASUMY("YTD","DIR","DOC")=$P(ASUMY(0),U,21)
  1.  Q
  1. WRITY ;EP ;WRITE YTD ISSUE DATA MASTER ASUMY("E#","REQ") REQUIRED
  1.  S ASUMY("CHGD")=0
  1.  I $P(ASUMY(0),U)'=ASUMY("CMO","RCR","VAL") S $P(ASUMY(0),U)=ASUMY("CMO","RCR","VAL"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,2)'=ASUMY("YTD","RCR","VAL") S $P(ASUMY(0),U,2)=ASUMY("YTD","RCR","VAL"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,3)'=ASUMY("YTD","NRC","VAL") S $P(ASUMY(0),U,3)=ASUMY("YTD","NRC","VAL"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,4)'=ASUMY("CMO","DIR","VAL") S $P(ASUMY(0),U,4)=ASUMY("CMO","DIR","VAL"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,5)'=ASUMY("YTD","DIR","VAL") S $P(ASUMY(0),U,5)=ASUMY("YTD","DIR","VAL"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,6)'=ASUMY("CMO","SCH","LI") S $P(ASUMY(0),U,6)=ASUMY("CMO","SCH","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,7)'=ASUMY("YTD","SCH","LI") S $P(ASUMY(0),U,7)=ASUMY("YTD","SCH","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,8)'=ASUMY("CMO","SCH","DOC") S $P(ASUMY(0),U,8)=ASUMY("CMO","SCH","DOC"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,9)'=ASUMY("YTD","SCH","DOC") S $P(ASUMY(0),U,9)=ASUMY("YTD","SCH","DOC"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,10)'=ASUMY("CMO","USC","LI") S $P(ASUMY(0),U,10)=ASUMY("CMO","USC","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,11)'=ASUMY("YTD","USC","LI") S $P(ASUMY(0),U,11)=ASUMY("YTD","USC","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,12)'=ASUMY("CMO","USC","DOC") S $P(ASUMY(0),U,12)=ASUMY("CMO","USC","DOC"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,13)'=ASUMY("YTD","USC","DOC") S $P(ASUMY(0),U,13)=ASUMY("YTD","USC","DOC"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,14)'=ASUMY("IS0","LI") S $P(ASUMY(0),U,14)=ASUMY("IS0","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,15)'=ASUMY("ISP","LI") S $P(ASUMY(0),U,15)=ASUMY("ISP","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,16)'=ASUMY("B/O","LI") S $P(ASUMY(0),U,16)=ASUMY("B/O","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,17)'=ASUMY("QTYADJ","LI") S $P(ASUMY(0),U,17)=ASUMY("QTYADJ","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,18)'=ASUMY("CMO","DIR","LI") S $P(ASUMY(0),U,18)=ASUMY("CMO","DIR","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,19)'=ASUMY("YTD","DIR","LI") S $P(ASUMY(0),U,19)=ASUMY("YTD","DIR","LI"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,20)'=ASUMY("CMO","DIR","DOC") S $P(ASUMY(0),U,20)=ASUMY("CMO","DIR","DOC"),ASUMY("CHGD")=1
  1.  I $P(ASUMY(0),U,21)'=ASUMY("YTD","DIR","DOC") S $P(ASUMY(0),U,21)=ASUMY("YTD","DIR","DOC"),ASUMY("CHGD")=1
  1.  I ASUMY("CHGD") D
  1.  .S ^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),1)=ASUMY(0)
  1.  .S ^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"),0)=ASUMY("E#","ACC")
  1.  .S DA=ASUMY("E#","REQ"),DIK="^ASUMY(" D IX^DIK ;Re xref new record
  1.  Q:$G(ASUMY("NOKL"))]""
  1.  K ASUMY
  1.  Q
  1. WRITE(X) ;EP ;WITH PARAMETER PASSING
  1.  S ASUMY("E#","REQ")=X
  1.  G WRITY
  1. ADDREQ(X) ;EP ; DIRECT REQUSITIONER ADD
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -3 : No Index Master found for Index # add requested for
  1.  ;  -4 : Station Index master already on file
  1.  ;  -7 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  ;  -8 : Failed IEN edit
  1.  ;  -10 : Sub Station IEN Index to be added to not in ASUMS variable
  1.  I X'?9N S Y=-8 Q  ;Failed IEN edit
  1.  I $D(^ASUMY(X,0)) S Y=0 Q  ;Sub Station already on file
  1.  S ^ASUMY(X,0)=X
  1.  S ^ASUMY(X,1,0)="^9002034.01PA"
  1.  S $P(^ASUMY(0),U,4)=$P(^ASUMY(ASUMY("E#","REQ"),1,0),U,4)+1 ;Add one to the count of Requsitioners
  1.  S $P(^ASUMY(0),U,3)=X ;Set last Requsitioner updated piece
  1.  S DA=X
  1.  S DIK="^ASUMY("
  1.  D IX^DIK K DIK,DA
  1.  Q
  1. ADDSSA(X) ;EP ; DIRECT SUBACTIVITY ADD -MUST HAVE IEN FOR REQ
  1.  I $G(ASUMY("E#","REQ"))']"" S Y=-11 Q  ;Usr IEN not available
  1.  I X'?1N.N D SSA^ASULDIRR(.X) Q:Y<0
  1.  S ASUMY("E#","SSA")=+X
  1.  I $D(^ASUMY(ASUMY("E#","REQ"),1,X,0)) S Y=0 Q  ;SSA already on file
  1.  S ^ASUMY(ASUMY("E#","REQ"),1,X,0)=X
  1.  S ^ASUMY(ASUMY("E#","REQ"),1,X,1,0)="^9002034.11PA"
  1.  ;Add one to the count of SSActivities for this User
  1.  S $P(^ASUMY(ASUMY("E#","REQ"),1,0),U,4)=$P(^ASUMY(ASUMY("E#","REQ"),1,0),U,4)+1
  1.  ;Set last SSActivity updated piece
  1.  S $P(^ASUMY(ASUMY("E#","REQ"),1,0),U,3)=X
  1.  S DA=X,DA(1)=ASUMY("E#","REQ")
  1.  S DIK="^ASUMY(DA(1),1,"
  1.  D IX^DIK K DIK,DA
  1.  Q
  1. ADDACC(X) ;EP ; DIRECT ACCOUNT ADD -MUST HAVE IEN FOR REQ & SSA
  1.  I $G(ASUMY("E#","REQ"))']"" S Y=-10 Q  ;Usr IEN not available
  1.  I $G(ASUMY("E#","SSA"))']"" S Y=-11 Q  ;Subactivity IEN not available
  1.  I X'?1N S Y=-4 Q  ;Input paramater did not pass Index IEN edit
  1.  I X=0!(X>5&(X'=9)) S Y=-4 Q  ;Input paramater did not pass Index IEN edit
  1.  I $D(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,X,0)) S Y=0 Q  ;SSA already on file
  1.  S ^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,X,0)=X
  1.  ;Add one to the count of Accounts for this SSActivities
  1.  S $P(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,0),U,4)=$P(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,0),U,4)+1
  1.  ;Set last SSActivity updated piece
  1.  S $P(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,0),U,3)=X
  1.  S DA=X,DA(1)=ASUMY("E#","SSA"),DA(2)=ASUMY("E#","REQ")
  1.  S DIK="^ASUMY(DA(2),1,DA(1),1,"
  1.  D IX^DIK K DIK,DA
  1.  Q
  1. REQ(X) ;EP ; DIRECT USER LOOKUP -MUST HAVE IEN FOR SUBSTATION
  1.  I X'?9N D REQ^ASULDIRR(.X) Q:Y<0
  1.  I $D(^ASUMY(X,0)) D
  1.  .S (Y,ASUMY("E#","REQ"))=X ;Record found for input parameter
  1.  E  D
  1.  .S ASUMY("E#","REQ")=X ;IEN to use for LAYGO call
  1.  .S Y=0 ;No record found for Input parameter
  1.  Q
  1. SSA(X) ;EP ; DIRECT SUBACTIVITY LOOKUP -MUST HAVE IEN FOR SST & USR
  1.  I $G(ASUMY("E#","REQ"))']"" S Y=-11 Q  ;Usr IEN not available
  1.  I X?1N.N D SSA^ASULDIRR(.X) Q:Y<0
  1.  S X=+X
  1.  I $D(^ASUMY(ASUMY("E#","REQ"),1,X,0)) D
  1.  .S (Y,ASUMY("E#","SSA"))=X ;Record found for input parameter
  1.  E  D
  1.  .S ASUMY("E#","SSA")=X ;IEN to use for LAYGO call
  1.  .S Y=0 ;No record found for Input parameter
  1.  Q
  1. ACC(X) ;EP ; DIRECT ACCOUNT LOOKUP -MUST HAVE IEN FOR SST USR & SSA
  1.  I $G(ASUMY("E#","REQ"))']"" S Y=-11 Q  ;Usr IEN not available
  1.  I $G(ASUMY("E#","SSA"))']"" S Y=-12 Q  ;Subactivity IEN not available
  1.  I X'?1N S Y=-4 Q  ;Input paramater did not pass Index IEN edit
  1.  I X=0!(X>5&(X'=9)) S Y=-4 Q  ;Input paramater did not pass Index IEN edit
  1.  I $D(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,X,0)) D
  1.  .S (Y,ASUMY("E#","ACC"))=X ;Record found for input parameter
  1.  E  D
  1.  .S ASUMY("E#","ACC")=X ;IEN to use for LAYGO call
  1.  .S Y=0 ;No record found for Input parameter
  1.  Q