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
