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

ASULDIRA.m

Go to the documentation of this file. 
  1. ASULDIRA ; IHS/ITSC/LMH -DIRECT ADD TABLE RECORD ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine is a utility which provides entry points to add new
  1.  ;entries into SAMS tables.
  1. SST(X) ;EP ; ADD NEW RECORD SUB STATION TABLE
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  K Y
  1.  I X["PL" S X=999,X(1)="OEH 121 PROJECTS"
  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 $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q  ;Not for Area Signed on as
  1.  I X'?5N S Y=-1 Q  ;Failed IEN edit
  1.  I $G(X(1))="" S X(1)=$P($G(^ASUL(2,X,0)),U) S:X(1)']"" X(1)="UNKNOWN"
  1.  S ^ASUL(18,X,0)=X(1)_U_$E(X,1,2)
  1.  S ^ASUL(18,X,1)=$S($E(X,3,5)=999:"PL",1:$E(X,4,5))
  1.  ;Add one to the count of Sub Stations
  1.  S $P(^ASUL(18,0),U,4)=$P(^ASUL(18,0),U,4)+1
  1.  ;Set last sub station updated piece
  1.  S $P(^ASUL(18,0),U,3)=X
  1.  D SST^ASULDIRR(X)
  1.  S DA=X,DIK="^ASUL(18," D IX^DIK K DIK,DA
  1.  Q
  1. USR(X) ;EP ; ADD NEW RECORD USER TABLE
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -1 : Failed IEN edit
  1.  ;  -2 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  K Y
  1.  I $L(X)=3 S ASUL(19,"USR")=X D USR^ASULALGO(.X) S X=ASUL(1,"AR","AP")_X
  1.  I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-2 Q  ;Not for Area Signed on as
  1.  S X(2)=$E(X,3,4) S:X(2)="00" X(2)=100
  1.  I $G(^ASUL(22,+(X(2)),0))']"" S Y=-4 Q  ;Not valid Program code
  1.  I X'?6N S Y=-1 Q  ;Failed IEN edit
  1.  I $G(X(1))="" S X(1)=$G(ASUL(22,"PGM","NM")) S:X(1)']"" X(1)="UNKNOWN"
  1.  S ^ASUL(19,X,0)=X(1)_U_ASUL(1,"AR","AP")_U_+($E(X,3,4))
  1.  S ^ASUL(19,X,1)=ASUL(19,"USR")
  1.  S $P(^ASUL(19,0),U,4)=$P(^ASUL(19,0),U,4)+1 ;Add one to User count
  1.  S $P(^ASUL(19,0),U,3)=X ;Set last User updated piece
  1.  D USR^ASULDIRR(X)
  1.  S DA=X,DIK="^ASUL(19," D IX^DIK K DIK,DA
  1.  Q
  1. REQ(X) ;EP ; ADD NEW RECORD REQUSITIONER TABLE
  1.  ;Error conditions passed back in 'Y'
  1.  ;  -11 : Failed IEN edit
  1.  ;  -12 : IEN not for Area signed into KERNEL with (DUZ 2)
  1.  K Y
  1.  I $G(ASUL(18,"SST","E#"))']"" D
  1.  .I X?9N D
  1.  ..S ASUL(18,"SST","E#")=$E(X,1,5) D SST(ASUL(18,"SST","E#")) Q:Y>0
  1.  ..S ASUL(19,"USR","E#")=$E(X,1,2)_$E(X,6,0) D USR(ASUL(19,"SST","E#")) Q:Y>0
  1.  .E  D
  1.  ..S Y=-14 Q
  1.  I $L(X)=3 D  Q:+Y<0  S X=ASUL(18,"SST","E#")_$E(ASUL(19,"USR","E#"),3,6)
  1.  .D USR^ASULDIRR(X)
  1.  ;I $E(X,1,2)'=ASUL(1,"AR","AP") S Y=-12 Q  ;Not for Area Signed on as
  1.  I X'?9N S Y=-11 Q  ;Failed IEN edit
  1.  I $G(X(1))="" S X(1)=ASUL(19,"USR","NM")_" @ "_ASUL(18,"SST","NM")
  1.  S ^ASUL(20,X,0)=X(1)_U_ASUL(19,"USR","E#")_U_ASUL(18,"SST","E#")_U_ASUL(1,"AR","AP")
  1.  ;The following line put something into the 2nd piece which is not
  1.  ;defined in the DD.  The Var X(3) does seem to get defined during the
  1.  ;running of the conversion.
  1.  S ^ASUL(20,X,1)=$S($G(X(3))]"":X(3),ASUL(1,"AR","AP")=59:2,1:"1.5")
  1.  ;Add one to the count of requsitioners
  1.  S $P(^ASUL(20,0),U,4)=$P(^ASUL(20,0),U,4)+1
  1.  ;Set last requsitioner updated piece
  1.  S $P(^ASUL(20,0),U,3)=X
  1.  ;S ^ASUL(20,X,2,0)="9002039.2I^0^0"   ;LMH  2/22/2000
  1.  D REQ^ASULDIRR(X)
  1.  S DA=X,DIK="^ASUL(20," D IX^DIK K DIK,DA
  1.  Q