ASUMXDIO ; IHS/ASDST/WAR -INDEX MASTER I/O ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000
;;This routine is a utility routine which provides an entry point to
;;read (retreve) data from the SAMS Index Master file.
;;(in global ^ASUMX & VA Fileman file ASUMST INDEX)
READ ;EP; TO SET INDEX MASTER FIELDS
;ASUMX("E#","IDX") (INDEX) MUST BE SET
Q:'$D(ASUMX("E#","IDX"))
I ASUMX("E#","IDX")'?8N S X=ASUMX("E#","IDX") D DIX^ASUMDIRM(.X) Q:Y<0
S ASUMX(0)=$G(^ASUMX(ASUMX("E#","IDX"),0))
S ASUMX(2)=$G(^ASUMX(ASUMX("E#","IDX"),2))
S ASUMX("IDX")=$P(ASUMX(0),U)
; ** LMH 6/13/00 NXT. LN. QUITS IF DELETED MSTR. INDEX ITEM **
Q:ASUMX("IDX")=""
I ASUMX("IDX")']"" D
.S ASUF("NOMST")=1,ASUMX("DESC")=""
E D
.I ASUMX("IDX")[999999!(ASUMX("IDX")="") D
..S ASUF("DLIDX")=1
..S ASUMX("DESC")=""
.E D
..S ASUMX("DESC")=$P(ASUMX(0),U,2)
..I ASUMX("IDX")'=$E(ASUMX("E#","IDX"),3,8) D
...W *7,!!,"***** PANIC -INDEX MASTER IS CORRUPTED !! -CAN NOT CONTINUE ******",!!!,"******** CALL YOUR SITE MANAGER TO HAVE CORRECTIVE ACTION PERFORMED ********"
...S ASUP("HLT")=1
S ASUMX("DESC",1)=$E(ASUMX("DESC"),1,30)
S ASUMX("DESC",2)=$E(ASUMX("DESC"),31,62)
S ASUMX("AR U/I")=$P(ASUMX(0),U,4)
S ASUMX("BCD")=$P(ASUMX(0),U,3)
S ASUMX("NSN")=$P(ASUMX(0),U,5)
N X D
.S (X,ASUMX("ACC"))=$P(ASUMX(0),U,6) D ACC^ASULDIRF(X)
.S (X,ASUMX("SOBJ"))=$P(ASUMX(0),U,7) D SSO^ASULDIRF(X)
.S (X,ASUMX("CAT"))=$P(ASUMX(0),U,8) D CAT^ASULDIRF(X)
S ASUMX("ESTB")=$P(ASUMX(0),U,9)
S ASUMX("DELIX")=$P(ASUMX(2),U)
S ASUMX("DELDS")=$P(ASUMX(2),U,2)
S ASUMX("DELDT")=$P(ASUMX(2),U,3)
Q
XK ;EP; TO KILL INDEX MASTER FIELDS
K ASUMX("E#","IDX")
XKF ;EP; TO KILL INDEX MASTER DATA FIELDS ONLY
K ASUMX
Q
IDX(X) ;EP ;WITH PARAMATER
S ASUMX("E#","IDX")=X
G READ
WRITE ;EP; WRITE INDEX MASTER
I ASUT("TRCD")="4A" D
.S ASUMX("IDX")=$E(ASUT("IXA","IDX","PT"),3,8)
.S ASUMX("E#","IDX")=ASUT("IXA","IDX","PT")
.S ASUMX("DESC")=ASUT("IXA","DESC")
.S ASUMX("AR U/I")=ASUT("IXA","AR U/I")
.S ASUMX("BCD")=ASUT("IXA","BCD")
.S ASUMX("NSN")=ASUT("IXA","NSN")
.S ASUMX("ACC")=ASUT("IXA","ACC")
.S ASUMX("SOBJ")=ASUT("IXA","SOBJ")
.S ASUMX("CAT")=ASUT("IXA","CAT")
.S ASUMX("ESTB")=ASUT("IXA","DTE")
.S (ASUMX("DELIX"),ASUMX("DELDS"),ASUMX("DELDT"))=""
Q:'$D(ASUMX("E#","IDX"))
S $P(ASUMX(0),U)=ASUMX("IDX")
S $P(ASUMX(0),U,2)=$G(ASUMX("DESC"))
S $P(ASUMX(0),U,4)=ASUMX("AR U/I")
S $P(ASUMX(0),U,3)=ASUMX("BCD")
S $P(ASUMX(0),U,5)=ASUMX("NSN")
S $P(ASUMX(0),U,6)=ASUMX("ACC")
S $P(ASUMX(0),U,7)=ASUMX("SOBJ")
S $P(ASUMX(0),U,8)=ASUMX("CAT")
S $P(ASUMX(0),U,9)=ASUMX("ESTB")
S $P(ASUMX(0),U,11)=$E(ASUMX("E#","IDX"),1,2)
S $P(ASUMX(2),U)=ASUMX("DELIX")
S $P(ASUMX(2),U,2)=ASUMX("DELDS")
S $P(ASUMX(2),U,3)=ASUMX("DELDT")
U ;EP ; WRITE INDEX MASTER
S ^ASUMX(ASUMX("E#","IDX"),0)=ASUMX(0)
S ^ASUMX(ASUMX("E#","IDX"),2)=ASUMX(2)
S DA=ASUMX("E#","IDX"),DIK="^ASUMX(" D IX^DIK
Q
ASUMXDIO ; IHS/ASDST/WAR -INDEX MASTER I/O ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000
+3 ;;This routine is a utility routine which provides an entry point to
+4 ;;read (retreve) data from the SAMS Index Master file.
+5 ;;(in global ^ASUMX & VA Fileman file ASUMST INDEX)
READ ;EP; TO SET INDEX MASTER FIELDS
+1 ;ASUMX("E#","IDX") (INDEX) MUST BE SET
+2 IF '$DATA(ASUMX("E#","IDX"))
QUIT
+3 IF ASUMX("E#","IDX")'?8N
SET X=ASUMX("E#","IDX")
DO DIX^ASUMDIRM(.X)
IF Y<0
QUIT
+4 SET ASUMX(0)=$GET(^ASUMX(ASUMX("E#","IDX"),0))
+5 SET ASUMX(2)=$GET(^ASUMX(ASUMX("E#","IDX"),2))
+6 SET ASUMX("IDX")=$PIECE(ASUMX(0),U)
+7 ; ** LMH 6/13/00 NXT. LN. QUITS IF DELETED MSTR. INDEX ITEM **
+8 IF ASUMX("IDX")=""
QUIT
+9 IF ASUMX("IDX")']""
Begin DoDot:1
+10 SET ASUF("NOMST")=1
SET ASUMX("DESC")=""
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 IF ASUMX("IDX")[999999!(ASUMX("IDX")="")
Begin DoDot:2
+13 SET ASUF("DLIDX")=1
+14 SET ASUMX("DESC")=""
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 SET ASUMX("DESC")=$PIECE(ASUMX(0),U,2)
+17 IF ASUMX("IDX")'=$EXTRACT(ASUMX("E#","IDX"),3,8)
Begin DoDot:3
+18 WRITE *7,!!,"***** PANIC -INDEX MASTER IS CORRUPTED !! -CAN NOT CONTINUE ******",!!!,"******** CALL YOUR SITE MANAGER TO HAVE CORRECTIVE ACTION PERFORMED ********"
+19 SET ASUP("HLT")=1
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET ASUMX("DESC",1)=$EXTRACT(ASUMX("DESC"),1,30)
+21 SET ASUMX("DESC",2)=$EXTRACT(ASUMX("DESC"),31,62)
+22 SET ASUMX("AR U/I")=$PIECE(ASUMX(0),U,4)
+23 SET ASUMX("BCD")=$PIECE(ASUMX(0),U,3)
+24 SET ASUMX("NSN")=$PIECE(ASUMX(0),U,5)
+25 NEW X
Begin DoDot:1
+26 SET (X,ASUMX("ACC"))=$PIECE(ASUMX(0),U,6)
DO ACC^ASULDIRF(X)
+27 SET (X,ASUMX("SOBJ"))=$PIECE(ASUMX(0),U,7)
DO SSO^ASULDIRF(X)
+28 SET (X,ASUMX("CAT"))=$PIECE(ASUMX(0),U,8)
DO CAT^ASULDIRF(X)
End DoDot:1
+29 SET ASUMX("ESTB")=$PIECE(ASUMX(0),U,9)
+30 SET ASUMX("DELIX")=$PIECE(ASUMX(2),U)
+31 SET ASUMX("DELDS")=$PIECE(ASUMX(2),U,2)
+32 SET ASUMX("DELDT")=$PIECE(ASUMX(2),U,3)
+33 QUIT
XK ;EP; TO KILL INDEX MASTER FIELDS
+1 KILL ASUMX("E#","IDX")
XKF ;EP; TO KILL INDEX MASTER DATA FIELDS ONLY
+1 KILL ASUMX
+2 QUIT
IDX(X) ;EP ;WITH PARAMATER
+1 SET ASUMX("E#","IDX")=X
+2 GOTO READ
WRITE ;EP; WRITE INDEX MASTER
+1 IF ASUT("TRCD")="4A"
Begin DoDot:1
+2 SET ASUMX("IDX")=$EXTRACT(ASUT("IXA","IDX","PT"),3,8)
+3 SET ASUMX("E#","IDX")=ASUT("IXA","IDX","PT")
+4 SET ASUMX("DESC")=ASUT("IXA","DESC")
+5 SET ASUMX("AR U/I")=ASUT("IXA","AR U/I")
+6 SET ASUMX("BCD")=ASUT("IXA","BCD")
+7 SET ASUMX("NSN")=ASUT("IXA","NSN")
+8 SET ASUMX("ACC")=ASUT("IXA","ACC")
+9 SET ASUMX("SOBJ")=ASUT("IXA","SOBJ")
+10 SET ASUMX("CAT")=ASUT("IXA","CAT")
+11 SET ASUMX("ESTB")=ASUT("IXA","DTE")
+12 SET (ASUMX("DELIX"),ASUMX("DELDS"),ASUMX("DELDT"))=""
End DoDot:1
+13 IF '$DATA(ASUMX("E#","IDX"))
QUIT
+14 SET $PIECE(ASUMX(0),U)=ASUMX("IDX")
+15 SET $PIECE(ASUMX(0),U,2)=$GET(ASUMX("DESC"))
+16 SET $PIECE(ASUMX(0),U,4)=ASUMX("AR U/I")
+17 SET $PIECE(ASUMX(0),U,3)=ASUMX("BCD")
+18 SET $PIECE(ASUMX(0),U,5)=ASUMX("NSN")
+19 SET $PIECE(ASUMX(0),U,6)=ASUMX("ACC")
+20 SET $PIECE(ASUMX(0),U,7)=ASUMX("SOBJ")
+21 SET $PIECE(ASUMX(0),U,8)=ASUMX("CAT")
+22 SET $PIECE(ASUMX(0),U,9)=ASUMX("ESTB")
+23 SET $PIECE(ASUMX(0),U,11)=$EXTRACT(ASUMX("E#","IDX"),1,2)
+24 SET $PIECE(ASUMX(2),U)=ASUMX("DELIX")
+25 SET $PIECE(ASUMX(2),U,2)=ASUMX("DELDS")
+26 SET $PIECE(ASUMX(2),U,3)=ASUMX("DELDT")
U ;EP ; WRITE INDEX MASTER
+1 SET ^ASUMX(ASUMX("E#","IDX"),0)=ASUMX(0)
+2 SET ^ASUMX(ASUMX("E#","IDX"),2)=ASUMX(2)
+3 SET DA=ASUMX("E#","IDX")
SET DIK="^ASUMX("
DO IX^DIK
+4 QUIT
