ASUV9IMW.m

ASUV9IMW ; IHS/ASDST/WAR -INVTR WRITE MASTER ;   

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000

 ;This is a Physical Inventory utility to write an Inventory Master.

 D ACCOUNT,STORLOC,INDEX

 Q

REPACCT ;EP;

 D DELACCT

 D SETACCT

 Q

NEWACCT ;EP;

 S:'$D(^ASUMV(0)) ^ASUMV(0)="ASUMST INVENTORY^9002030P^^"

 S ASUL(9,"E#","ACC")=$S(ASUMV("ACC")=9:6,1:ASUMV("ACC"))

 S $P(^ASUMV(0),U,3)=ASUMV("E#","ASA")

SETACCT ;

 S $P(^ASUMV(0),U,4)=$P(^ASUMV(0),U,4)+1

 S ^ASUMV("B",ASUL(9,"E#","ACC"),ASUMV("E#","ASA"))=""

 S ^ASUMV(ASUMV("E#","ASA"),1,0)="^9002030.01PA"

 S ASUMV(0,"ASA")=ASUL(9,"E#","ACC")_U_ASUV("DT")_"^^^"_ASUL(2,"STA","E#")

 S ^ASUMV(ASUMV("E#","ASA"),0)=ASUMV(0,"ASA")

 S ASUMV("INVBEG")=ASUV("DT")

 Q

ACCOUNT ;EP;

 Q:'$D(ASUMV("E#","ASA"))

 S $P(ASUMV(0,"ASA"),U,2)=ASUMV("INVBEG")

 S $P(ASUMV(0,"ASA"),U,3)=ASUMV("VOU")

 S $P(ASUMV(0,"ASA"),U,4)=ASUMV("MODE")

 S ^ASUMV(ASUMV("E#","ASA"),0)=ASUMV(0,"ASA")

 Q

DELACCT ;EP;

 K ^ASUMV(ASUMV("E#","ASA")),^ASUMV("B",ASUL(9,"E#","ACC"))

 S $P(^ASUMV(0),U,4)=$P(^ASUMV(0),U,4)-1

 Q

NEWSLC ;EP;

 I '$D(^ASUMV(ASUMV("E#","ASA"),1,0)) D

 .S ^ASUMV(ASUMV("E#","ASA"),1,0)="^9002030.01PA^"_ASUMV("E#","SLC")_"^1"

 E  D

 .S $P(^ASUMV(ASUMV("E#","ASA"),1,0),U,3)=ASUMV("E#","SLC"),$P(^(0),U,4)=$P(^(0),U,4)+1

 S ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)=ASUMS("SLC")

 S ^ASUMV(ASUMV("E#","ASA"),1,"B",ASUMS("SLC"),ASUMV("E#","SLC"))=""

 D STORLOC^ASUV9IMR

STORLOC ;EP;

 Q:'$D(ASUMV("E#","ASA"))

 Q:'$D(ASUMV("E#","SLC"))

 S $P(ASUMV(0,"SLC"),U,2)=ASUMV("SL E#")

 S ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)=ASUMV(0,"SLC")

 Q

NEWIDX ;EP;

 I '$D(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0)) D

 .S ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0)="^9002030.11PA^"_ASUMV("IDX")_"^1"

 E  D

 .S $P(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0),U,3)=ASUMV("E#","INDX"),$P(^(0),U,4)=$P(^(0),U,4)+1

 I '$D(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)) D

 .D INDEX

 E  D

 .S ASUMV(0,"IDX")=^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)

 Q

INDEX ;EP;

 Q:'$D(ASUMV("E#","ASA"))

 Q:'$D(ASUMV("E#","SLC"))

 Q:'$D(ASUMV("E#","INDX"))

 S $P(ASUMV(0,"IDX"),U)=$G(ASUMX("E#","IDX"))

 S $P(ASUMV(0,"IDX"),U,2)=$G(ASUMV("STA"))

 S $P(ASUMV(0,"IDX"),U,3)=$G(ASUMV("QTY","STAM"))

 S $P(ASUMV(0,"IDX"),U,4)=$G(ASUMV("U/C"))

 S $P(ASUMV(0,"IDX"),U,5)=$G(ASUMV("CNT","1ST"))

 S $P(ASUMV(0,"IDX"),U,6)=$G(ASUMV("CNT","2ND"))

 S $P(ASUMV(0,"IDX"),U,7)=$G(ASUMV("QTY","DIF"))

 S $P(ASUMV(0,"IDX"),U,8)=$G(ASUMV("ADJQTY"))

 S $P(ASUMV(0,"IDX"),U,9)=$G(ASUMV("CNT-ENT"))

 S ASUMV("IDX")=$P($G(^ASUMX(ASUMX("E#","IDX"),0)),U)

 S $P(ASUMV(0,"IDX"),U,10)=$G(ASUMV("IDX"))

 S ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)=ASUMV(0,"IDX")

 Q

XREF ;EP;

 S DA=ASUMV("E#","SLC")

 S DIK="^ASUMV("_ASUMV("E#","ASA")_",1,",DA(1)=ASUMV("E#","ASA") D IXALL^DIK

 Q

ASUV9IMW  ; IHS/ASDST/WAR -INVTR WRITE MASTER ;   

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000

 +3       ;This is a Physical Inventory utility to write an Inventory Master.

 +4        DO ACCOUNT

           DO STORLOC

           DO INDEX

 +5        QUIT 

REPACCT   ;EP;

 +1        DO DELACCT

 +2        DO SETACCT

 +3        QUIT 

NEWACCT   ;EP;

 +1        IF '$DATA(^ASUMV(0))

               SET ^ASUMV(0)="ASUMST INVENTORY^9002030P^^"

 +2        SET ASUL(9,"E#","ACC")=$SELECT(ASUMV("ACC")=9:6,1:ASUMV("ACC"))

 +3        SET $PIECE(^ASUMV(0),U,3)=ASUMV("E#","ASA")

SETACCT   ;

 +1        SET $PIECE(^ASUMV(0),U,4)=$PIECE(^ASUMV(0),U,4)+1

 +2        SET ^ASUMV("B",ASUL(9,"E#","ACC"),ASUMV("E#","ASA"))=""

 +3        SET ^ASUMV(ASUMV("E#","ASA"),1,0)="^9002030.01PA"

 +4        SET ASUMV(0,"ASA")=ASUL(9,"E#","ACC")_U_ASUV("DT")_"^^^"_ASUL(2,"STA","E#")

 +5        SET ^ASUMV(ASUMV("E#","ASA"),0)=ASUMV(0,"ASA")

 +6        SET ASUMV("INVBEG")=ASUV("DT")

 +7        QUIT 

ACCOUNT   ;EP;

 +1        IF '$DATA(ASUMV("E#","ASA"))

               QUIT 

 +2        SET $PIECE(ASUMV(0,"ASA"),U,2)=ASUMV("INVBEG")

 +3        SET $PIECE(ASUMV(0,"ASA"),U,3)=ASUMV("VOU")

 +4        SET $PIECE(ASUMV(0,"ASA"),U,4)=ASUMV("MODE")

 +5        SET ^ASUMV(ASUMV("E#","ASA"),0)=ASUMV(0,"ASA")

 +6        QUIT 

DELACCT   ;EP;

 +1        KILL ^ASUMV(ASUMV("E#","ASA")),^ASUMV("B",ASUL(9,"E#","ACC"))

 +2        SET $PIECE(^ASUMV(0),U,4)=$PIECE(^ASUMV(0),U,4)-1

 +3        QUIT 

NEWSLC    ;EP;

 +1        IF '$DATA(^ASUMV(ASUMV("E#","ASA"),1,0))

               Begin DoDot:1

 +2                SET ^ASUMV(ASUMV("E#","ASA"),1,0)="^9002030.01PA^"_ASUMV("E#","SLC")_"^1"

               End DoDot:1

 +3       IF '$TEST

               Begin DoDot:1

 +4                SET $PIECE(^ASUMV(ASUMV("E#","ASA"),1,0),U,3)=ASUMV("E#","SLC")

                   SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

               End DoDot:1

 +5        SET ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)=ASUMS("SLC")

 +6        SET ^ASUMV(ASUMV("E#","ASA"),1,"B",ASUMS("SLC"),ASUMV("E#","SLC"))=""

 +7        DO STORLOC^ASUV9IMR

STORLOC   ;EP;

 +1        IF '$DATA(ASUMV("E#","ASA"))

               QUIT 

 +2        IF '$DATA(ASUMV("E#","SLC"))

               QUIT 

 +3        SET $PIECE(ASUMV(0,"SLC"),U,2)=ASUMV("SL E#")

 +4        SET ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)=ASUMV(0,"SLC")

 +5        QUIT 

NEWIDX    ;EP;

 +1        IF '$DATA(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0))

               Begin DoDot:1

 +2                SET ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0)="^9002030.11PA^"_ASUMV("IDX")_"^1"

               End DoDot:1

 +3       IF '$TEST

               Begin DoDot:1

 +4                SET $PIECE(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,0),U,3)=ASUMV("E#","INDX")

                   SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

               End DoDot:1

 +5        IF '$DATA(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0))

               Begin DoDot:1

 +6                DO INDEX

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                SET ASUMV(0,"IDX")=^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)

               End DoDot:1

 +9        QUIT 

INDEX     ;EP;

 +1        IF '$DATA(ASUMV("E#","ASA"))

               QUIT 

 +2        IF '$DATA(ASUMV("E#","SLC"))

               QUIT 

 +3        IF '$DATA(ASUMV("E#","INDX"))

               QUIT 

 +4        SET $PIECE(ASUMV(0,"IDX"),U)=$GET(ASUMX("E#","IDX"))

 +5        SET $PIECE(ASUMV(0,"IDX"),U,2)=$GET(ASUMV("STA"))

 +6        SET $PIECE(ASUMV(0,"IDX"),U,3)=$GET(ASUMV("QTY","STAM"))

 +7        SET $PIECE(ASUMV(0,"IDX"),U,4)=$GET(ASUMV("U/C"))

 +8        SET $PIECE(ASUMV(0,"IDX"),U,5)=$GET(ASUMV("CNT","1ST"))

 +9        SET $PIECE(ASUMV(0,"IDX"),U,6)=$GET(ASUMV("CNT","2ND"))

 +10       SET $PIECE(ASUMV(0,"IDX"),U,7)=$GET(ASUMV("QTY","DIF"))

 +11       SET $PIECE(ASUMV(0,"IDX"),U,8)=$GET(ASUMV("ADJQTY"))

 +12       SET $PIECE(ASUMV(0,"IDX"),U,9)=$GET(ASUMV("CNT-ENT"))

 +13       SET ASUMV("IDX")=$PIECE($GET(^ASUMX(ASUMX("E#","IDX"),0)),U)

 +14       SET $PIECE(ASUMV(0,"IDX"),U,10)=$GET(ASUMV("IDX"))

 +15       SET ^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)=ASUMV(0,"IDX")

 +16       QUIT 

XREF      ;EP;

 +1        SET DA=ASUMV("E#","SLC")

 +2        SET DIK="^ASUMV("_ASUMV("E#","ASA")_",1,"

           SET DA(1)=ASUMV("E#","ASA")

           DO IXALL^DIK

 +3        QUIT