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