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