ASUMXDIO.m

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