ASUV9IMR.m

ASUV9IMR ; IHS/ITSC/LMH -INVTR READ MASTER ; 

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

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

 D ACCOUNT,STORLOC,INDEX

 Q

ACCOUNT ;EP;

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

 I '$D(^ASUMV(ASUMV("E#","ASA"),0)) S ASUF("ACC")=0 Q

 S ASUF("ACC")=1

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

 S ASUMV("ACC")=$E(ASUMV("E#","ASA"),6)

 S ASUL(9,"E#","ACC")=$P(ASUMV(0,"ASA"),U)

 S:ASUL(9,"E#","ACC")']"" ASUL(9,"E#","ACC")=ASUMV("ACC")

 D ACC^ASULDIRF(ASUL(9,"E#","ACC"))

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

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

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

 S:$G(ASUL(2,"STA","E#"))']"" ASUL(2,"STA","E#")=$P(ASUMV(0,"ASA"),U,5)

 Q

STORLOC ;EP;

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

 Q:$G(ASUMV("E#","SLC"))'?1N.N

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

 S ASUMV("SLC")=$P(ASUMV(0,"SLC"),U)

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

 I ASUMV("SL E#")']"" D

 .S ASUMV("SL E#")=$O(^ASUL(10,"B",ASUMV("SLC"),""))

 S ASUMV("SL NM")=$P(^ASUL(10,ASUMV("SL E#"),0),U,2)

 Q

INDEX ;EP;

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

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

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

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

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

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

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

 S:ASUMV("IDX")']"" ASUMV("IDX")=$E(ASUMX("E#","IDX"),3,8)_"*"

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

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

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

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

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

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

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

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

 Q

ASUV9IMR  ; IHS/ITSC/LMH -INVTR READ MASTER ; 

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

 +2       ;This is a Physical Inventory utility to read an Inventory Master.

 +3        DO ACCOUNT

           DO STORLOC

           DO INDEX

 +4        QUIT 

ACCOUNT   ;EP;

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

               QUIT 

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

               SET ASUF("ACC")=0

               QUIT 

 +3        SET ASUF("ACC")=1

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

 +5        SET ASUMV("ACC")=$EXTRACT(ASUMV("E#","ASA"),6)

 +6        SET ASUL(9,"E#","ACC")=$PIECE(ASUMV(0,"ASA"),U)

 +7        IF ASUL(9,"E#","ACC")']""

               SET ASUL(9,"E#","ACC")=ASUMV("ACC")

 +8        DO ACC^ASULDIRF(ASUL(9,"E#","ACC"))

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

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

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

 +12       IF $GET(ASUL(2,"STA","E#"))']""

               SET ASUL(2,"STA","E#")=$PIECE(ASUMV(0,"ASA"),U,5)

 +13       QUIT 

STORLOC   ;EP;

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

               QUIT 

 +2        IF $GET(ASUMV("E#","SLC"))'?1N.N

               QUIT 

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

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

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

 +6        IF ASUMV("SL E#")']""

               Begin DoDot:1

 +7                SET ASUMV("SL E#")=$ORDER(^ASUL(10,"B",ASUMV("SLC"),""))

               End DoDot:1

 +8        SET ASUMV("SL NM")=$PIECE(^ASUL(10,ASUMV("SL E#"),0),U,2)

 +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 ASUMV(0,"IDX")=^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"),0)

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

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

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

 +8        IF ASUMV("IDX")']""

               SET ASUMV("IDX")=$EXTRACT(ASUMX("E#","IDX"),3,8)_"*"

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

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

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

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

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

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

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

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

 +17       QUIT