ASUV2RN ; IHS/ITSC/LMH -ENTER RE-COUNTS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine accepts Physical Inventory 'Re-Count' data input.
D:'$D(DT) ^XBKVAR
ACCOUNT ;
F D I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.D ACCT
.I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.I ASUMV("E#","ASA")="" S ASUF=1 Q
.S DIR("A")="ENTER RE-COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
.S DIR("B")="Y"
.S DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select items or '^' to exit"
.S DIR(0)="SA^Y:Yes;N:No"
.D ^DIR K DIR
.I $D(DUOUT)!($D(DTOUT)) Q
.S ASUR("RSVP")=$E(Y)
.I ASUR("RSVP")="Y" D
..D SLCLOOP
..K ASUR("RSVP")
.E D ASUV2RN3
K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX("E#")
K DTOUT,DUOUT,DIC,DIR,X,Y
Q
SLCLOOP ;EP;
D CKIT
I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
S ASUMV("E#","SLC")=0
S ASUF("SLC")=1
F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D Q:$D(DTOUT) Q:$D(DUOUT)
.D STORLOC^ASUV9IMR
.S ASUMV("E#","INDX")=0
.D CLS^ASUUHDG
.S ASUF("IDX")=0
.D IDXLOOP
D
.I ASUF("SLC") W !,"ALL RE-COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!! Q
.I 'ASUF("IDX") D
..W !,"ALL RE-COUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -"
..I $G(ASUV("SL NM"))']"" D STORLOC^ASUV9IMR
..W $G(ASUV("SL NM"))," HAVE BEEN ENTERED",!!!
S DIR(0)="E" D ^DIR K DIR
Q
IDXLOOP ;EP;
S ASUMV("E#","INDX")=0
F S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N D Q:$D(DTOUT) Q:$D(DUOUT)
.D ASUV2RN2
Q
LOOP ;EP;
S ASUMV("E#","ASA")=ASUL(2,"STA","E#")
F S ASUMV("E#","ASA")=$O(^ASUMV(ASUMV("E#","ASA"))) Q:ASUMV("E#","ASA")'?1N.N D SLCLOOP Q:$D(DTOUT) Q:$D(DUOUT)
Q
ASUV2RN2 ;
I ASUMV("E#","INDX")'?1N.N G XIT2
D INDEX^ASUV9IMR
I ASUMV("IDX")["*" W !,"Master has been deleted",*7 Q
D READ^ASUMXDIO
I ASUMV("CNT-ENT")=2,ASUF("IDX")<2 G XIT2
I ASUMV("QTY","DIF")=0,$G(ASUF)<2 G XIT2
I 'ASUF("IDX") W !,"NOW PROCESSING ALL'",ASUMV("SLC"),"' STORAGE LOCATION ENTRIES",! S ASUF("IDX")=1
S ASUF("SLC")=0
W !!,"INDEX : ",ASUMX("IDX")
S ASUMS("STA")=$P(^ASUMS(ASUMV("STA"),0),U)
W ?15,ASUMX("DESC",1),?65,"STATION : ",ASUMS("STA")
K DIR
S DIR("B")=$S(ASUMV("CNT","2ND")>0:ASUMV("CNT","2ND"),1:"")
S DIR("A")="ENTER RE-COUNT QUANTITY"
S DIR(0)="NO^0:999999:0^K:X[""."" X" D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) G XIT2
S ASUR("QTY")=X
I ASUR("QTY")="" G XIT2
S ASUMV("CNT","2ND")=ASUR("QTY")
S ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
S ASUMV("CNT-ENT")=2
D INDEX^ASUV9IMW
XIT2 ;
Q
ASUV2RN3 ;
S ASUR("ACC")=ASUMV("ACC")
F D I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.S DIC("A")="ENTER RE-COUNTS FOR WHAT STORAGE LOCATION CODE "
.S DIC="9002030.1",DIC(0)="AMEZ"
.D ^DIC K DIC
.I $D(DUOUT)!($D(DTOUT)) Q
.S ASUR("SLC")=$P(Y,U,2),ASUMV("E#","SLC")=+Y
.I ASUR("SLC")="" S ASUF=1 Q
.S ASUV("SL NM")=$P(Y(0),U,2)
.I '$D(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)) D Q
..W !,"NO ITEMS FOR STORAGE LOCATION ",ASUR("SLC")," IN ACCOUNT ",ASUL(9,"ACC","NM")," INVENTORY MASTER"
..D PAUSE
.E D
..S DIR("A")="ENTER RE-COUNTS FOR ALL ITEMS? (Y/N) "
..S DIR("B")="Y"
..S DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select item to enter re-counts on"
..S DIR(0)="SA^Y:Yes;N:No"
..D ^DIR K DIR
..I $D(DUOUT)!($D(DTOUT)) Q
..S ASUR("RSVP")=$E(Y)
..I ASUR("RSVP")="Y" D
...S ASUF("IDX")=0
...D IDXLOOP
...I ASUF("IDX")=0 W !,"ALL STORAGE LOCATION ",ASUV("SL NM")," '",ASUR("SLC"),"' RE-RECOUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM")
..E D
...D RDINDX
.S ASUF=0
S ASUF=0
Q
RDINDX ;
F D I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.W ! D ^ASUV9IDX
.I $D(DUOUT)!($D(DTOUT)) Q
.I ASUMX("E#","IDX")']"" S ASUF=1 Q
.S ASUMV("E#","INDX")="",ASUF("IDX")=2
.F ASUC("TR")=1:1 S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,"B",ASUMX("E#","IDX"),ASUMV("E#","INDX"))) D Q:ASUMV("E#","INDX")=""
..I ASUMV("E#","INDX")]"" D
...D ASUV2RN2
..E I ASUC("TR")=1 D
...W !,"INDEX NOT IN INVENTORY MASTER FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),!,"STORAGE LOCATION ",ASUR("SLC")
...D PAUSE
.S ASUF=0
S ASUF=0
Q
PAUSE ;
S DIR(0)="E" D ^DIR K DIR
Q
ASUV2RN0 ;EP ;CHECK RE-COUNTS;
D CKIT G:($G(ASUF)>0) EXIT
S ASUMV("E#","SLC")=0
F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
.D STORLOC^ASUV9IMR
.S ASUMV("E#","INDX")=0
.F S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N D I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
..D INDEX^ASUV9IMR
..Q:ASUMV("IDX")["*" ;MASTER HAS BEEN DELETED
..I ASUMV("QTY","DIF")=0 Q
..I ASUMV("CNT-ENT")=2 Q
..S ASUF=1
I ASUF=1 D
.S ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN RE-COUNTED -RE-COUNT NOT MARKED AS COMPLETE"""
.D V^ASUUPLOG
G EXIT
FLAGIT3 ;EP;
S ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED -RE-COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUL(9,"ACC","NM"))_" IS NOW IN RESEARCH MODE"""
D V^ASUUPLOG
S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=3
EXIT ;
Q
ACCT ;EP;ACCOUNT
I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G EXIT
D CLS^ASUUHDG
S DIC("A")="ENTER RE-COUNTS FOR WHAT ACCOUNT? "
S DIC="9002039.09",DIC(0)="AMEZQ"
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT)) Q
Q:'$D(Y)
I Y>0 D
.S ASUF=0
.S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
.D ACC^ASULDIRF(ASUMV("ACC"))
E D Q
.S ASUMV("E#","ASA")=ASUL(2,"STA","E#") S ASUF=1
I $D(^ASUMV(ASUMV("E#","ASA"),0)) D
.D ACCOUNT^ASUV9IMR,CKIT
E D
.S ASURX="W !,""NO INVENTORY ACTIVE FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUMV("E#","ACC","NM"))_"""",ASUF=1
.D V^ASUUPLOG
G EXIT
CKIT ;EP;
I ASUMV("MODE")=2 S ASUF=0 Q
I ASUMV("MODE")=0 S ASUV("MSG")="INVENTORY NOT BEGUN " D MESSAGE Q
I ASUMV("MODE")=1 S ASUV("MSG")="FIRST COUNTS NOT COMPLETED " D MESSAGE Q
S ASUV("MSG")="RE-COUNTS COMPLETED " D MESSAGE
I ASUF=2 S ASUF=1 Q
Q:$D(DTOUT)!($D(DUOUT))
Q:ASUK("PTR-Q")
S DIR(0)="Y",DIR("A")="DO YOU WANT TO RE-PRINT THE RE-COUNT LISTING? ",DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST" D ^DIR K DIR
I Y S ASUF=0,ASUF("RPRN")=1
Q
MESSAGE ;
S ASUV("MSG",1)=$G(ASUV("MSG",1))
S ASURX="W !,"""_ASUV("MSG",1)_""",!,"""_ASUV("MSG")_"FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUL(9,"ACC","NM"))_" INVENTORY"""
S ASURX=ASURX_",!,""WHICH IS IN "_$S(ASUMV("MODE")=0:"INITIALIZED",ASUMV("MODE")=3:"RESEARCH",ASUMV("MODE")=4:"COMPLETED",1:"FIRST COUNT")_" MODE"""
I ASUV("MSG",1)="" D
.S ASUF=2
E D
.S ASUF=1
D V^ASUUPLOG
K ASUV("MSG")
Q
ASUV2RN ; IHS/ITSC/LMH -ENTER RE-COUNTS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine accepts Physical Inventory 'Re-Count' data input.
+3 IF '$DATA(DT)
DO ^XBKVAR
ACCOUNT ;
+1 FOR
Begin DoDot:1
+2 DO ACCT
+3 IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+4 IF ASUMV("E#","ASA")=""
SET ASUF=1
QUIT
+5 SET DIR("A")="ENTER RE-COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
+6 SET DIR("B")="Y"
+7 SET DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select items or '^' to exit"
+8 SET DIR(0)="SA^Y:Yes;N:No"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+11 SET ASUR("RSVP")=$EXTRACT(Y)
+12 IF ASUR("RSVP")="Y"
Begin DoDot:2
+13 DO SLCLOOP
+14 KILL ASUR("RSVP")
End DoDot:2
+15 IF '$TEST
DO ASUV2RN3
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+16 KILL ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX("E#")
+17 KILL DTOUT,DUOUT,DIC,DIR,X,Y
+18 QUIT
SLCLOOP ;EP;
+1 DO CKIT
+2 IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+3 SET ASUMV("E#","SLC")=0
+4 SET ASUF("SLC")=1
+5 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:1
+6 DO STORLOC^ASUV9IMR
+7 SET ASUMV("E#","INDX")=0
+8 DO CLS^ASUUHDG
+9 SET ASUF("IDX")=0
+10 DO IDXLOOP
End DoDot:1
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+11 Begin DoDot:1
+12 IF ASUF("SLC")
WRITE !,"ALL RE-COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!!
QUIT
+13 IF 'ASUF("IDX")
Begin DoDot:2
+14 WRITE !,"ALL RE-COUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -"
+15 IF $GET(ASUV("SL NM"))']""
DO STORLOC^ASUV9IMR
+16 WRITE $GET(ASUV("SL NM"))," HAVE BEEN ENTERED",!!!
End DoDot:2
End DoDot:1
+17 SET DIR(0)="E"
DO ^DIR
KILL DIR
+18 QUIT
IDXLOOP ;EP;
+1 SET ASUMV("E#","INDX")=0
+2 FOR
SET ASUMV("E#","INDX")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX")))
IF ASUMV("E#","INDX")'?1N.N
QUIT
Begin DoDot:1
+3 DO ASUV2RN2
End DoDot:1
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+4 QUIT
LOOP ;EP;
+1 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
+2 FOR
SET ASUMV("E#","ASA")=$ORDER(^ASUMV(ASUMV("E#","ASA")))
IF ASUMV("E#","ASA")'?1N.N
QUIT
DO SLCLOOP
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+3 QUIT
ASUV2RN2 ;
+1 IF ASUMV("E#","INDX")'?1N.N
GOTO XIT2
+2 DO INDEX^ASUV9IMR
+3 IF ASUMV("IDX")["*"
WRITE !,"Master has been deleted",*7
QUIT
+4 DO READ^ASUMXDIO
+5 IF ASUMV("CNT-ENT")=2
IF ASUF("IDX")<2
GOTO XIT2
+6 IF ASUMV("QTY","DIF")=0
IF $GET(ASUF)<2
GOTO XIT2
+7 IF 'ASUF("IDX")
WRITE !,"NOW PROCESSING ALL'",ASUMV("SLC"),"' STORAGE LOCATION ENTRIES",!
SET ASUF("IDX")=1
+8 SET ASUF("SLC")=0
+9 WRITE !!,"INDEX : ",ASUMX("IDX")
+10 SET ASUMS("STA")=$PIECE(^ASUMS(ASUMV("STA"),0),U)
+11 WRITE ?15,ASUMX("DESC",1),?65,"STATION : ",ASUMS("STA")
+12 KILL DIR
+13 SET DIR("B")=$SELECT(ASUMV("CNT","2ND")>0:ASUMV("CNT","2ND"),1:"")
+14 SET DIR("A")="ENTER RE-COUNT QUANTITY"
+15 SET DIR(0)="NO^0:999999:0^K:X[""."" X"
DO ^DIR
KILL DIR
+16 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO XIT2
+17 SET ASUR("QTY")=X
+18 IF ASUR("QTY")=""
GOTO XIT2
+19 SET ASUMV("CNT","2ND")=ASUR("QTY")
+20 SET ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
+21 SET ASUMV("CNT-ENT")=2
+22 DO INDEX^ASUV9IMW
XIT2 ;
+1 QUIT
ASUV2RN3 ;
+1 SET ASUR("ACC")=ASUMV("ACC")
+2 FOR
Begin DoDot:1
+3 SET DIC("A")="ENTER RE-COUNTS FOR WHAT STORAGE LOCATION CODE "
+4 SET DIC="9002030.1"
SET DIC(0)="AMEZ"
+5 DO ^DIC
KILL DIC
+6 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+7 SET ASUR("SLC")=$PIECE(Y,U,2)
SET ASUMV("E#","SLC")=+Y
+8 IF ASUR("SLC")=""
SET ASUF=1
QUIT
+9 SET ASUV("SL NM")=$PIECE(Y(0),U,2)
+10 IF '$DATA(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0))
Begin DoDot:2
+11 WRITE !,"NO ITEMS FOR STORAGE LOCATION ",ASUR("SLC")," IN ACCOUNT ",ASUL(9,"ACC","NM")," INVENTORY MASTER"
+12 DO PAUSE
End DoDot:2
QUIT
+13 IF '$TEST
Begin DoDot:2
+14 SET DIR("A")="ENTER RE-COUNTS FOR ALL ITEMS? (Y/N) "
+15 SET DIR("B")="Y"
+16 SET DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select item to enter re-counts on"
+17 SET DIR(0)="SA^Y:Yes;N:No"
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+20 SET ASUR("RSVP")=$EXTRACT(Y)
+21 IF ASUR("RSVP")="Y"
Begin DoDot:3
+22 SET ASUF("IDX")=0
+23 DO IDXLOOP
+24 IF ASUF("IDX")=0
WRITE !,"ALL STORAGE LOCATION ",ASUV("SL NM")," '",ASUR("SLC"),"' RE-RECOUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM")
End DoDot:3
+25 IF '$TEST
Begin DoDot:3
+26 DO RDINDX
End DoDot:3
End DoDot:2
+27 SET ASUF=0
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+28 SET ASUF=0
+29 QUIT
RDINDX ;
+1 FOR
Begin DoDot:1
+2 WRITE !
DO ^ASUV9IDX
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+4 IF ASUMX("E#","IDX")']""
SET ASUF=1
QUIT
+5 SET ASUMV("E#","INDX")=""
SET ASUF("IDX")=2
+6 FOR ASUC("TR")=1:1
SET ASUMV("E#","INDX")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,"B",ASUMX("E#","IDX"),ASUMV("E#","INDX")))
Begin DoDot:2
+7 IF ASUMV("E#","INDX")]""
Begin DoDot:3
+8 DO ASUV2RN2
End DoDot:3
+9 IF '$TEST
IF ASUC("TR")=1
Begin DoDot:3
+10 WRITE !,"INDEX NOT IN INVENTORY MASTER FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),!,"STORAGE LOCATION ",ASUR("SLC")
+11 DO PAUSE
End DoDot:3
End DoDot:2
IF ASUMV("E#","INDX")=""
QUIT
+12 SET ASUF=0
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+13 SET ASUF=0
+14 QUIT
PAUSE ;
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 QUIT
ASUV2RN0 ;EP ;CHECK RE-COUNTS;
+1 DO CKIT
IF ($GET(ASUF)>0)
GOTO EXIT
+2 SET ASUMV("E#","SLC")=0
+3 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:1
+4 DO STORLOC^ASUV9IMR
+5 SET ASUMV("E#","INDX")=0
+6 FOR
SET ASUMV("E#","INDX")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX")))
IF ASUMV("E#","INDX")'?1N.N
QUIT
Begin DoDot:2
+7 DO INDEX^ASUV9IMR
+8 ;MASTER HAS BEEN DELETED
IF ASUMV("IDX")["*"
QUIT
+9 IF ASUMV("QTY","DIF")=0
QUIT
+10 IF ASUMV("CNT-ENT")=2
QUIT
+11 SET ASUF=1
End DoDot:2
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(ASUF)>0)
QUIT
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(ASUF)>0)
QUIT
+12 IF ASUF=1
Begin DoDot:1
+13 SET ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN RE-COUNTED -RE-COUNT NOT MARKED AS COMPLETE"""
+14 DO V^ASUUPLOG
End DoDot:1
+15 GOTO EXIT
FLAGIT3 ;EP;
+1 SET ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED -RE-COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$GET(ASUL(9,"ACC","NM"))_" IS NOW IN RESEARCH MODE"""
+2 DO V^ASUUPLOG
+3 SET $PIECE(^ASUMV(ASUMV("E#","ASA"),0),U,4)=3
EXIT ;
+1 QUIT
ACCT ;EP;ACCOUNT
+1 IF $GET(ASUL(2,"STA","E#"))']""
DO STA^ASUV0NT
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+2 DO CLS^ASUUHDG
+3 SET DIC("A")="ENTER RE-COUNTS FOR WHAT ACCOUNT? "
+4 SET DIC="9002039.09"
SET DIC(0)="AMEZQ"
+5 DO ^DIC
KILL DIC
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 IF '$DATA(Y)
QUIT
+8 IF Y>0
Begin DoDot:1
+9 SET ASUF=0
+10 SET ASUMV("ACC")=$PIECE(Y,U)
SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
+11 DO ACC^ASULDIRF(ASUMV("ACC"))
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
SET ASUF=1
End DoDot:1
QUIT
+14 IF $DATA(^ASUMV(ASUMV("E#","ASA"),0))
Begin DoDot:1
+15 DO ACCOUNT^ASUV9IMR
DO CKIT
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET ASURX="W !,""NO INVENTORY ACTIVE FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$GET(ASUMV("E#","ACC","NM"))_""""
SET ASUF=1
+18 DO V^ASUUPLOG
End DoDot:1
+19 GOTO EXIT
CKIT ;EP;
+1 IF ASUMV("MODE")=2
SET ASUF=0
QUIT
+2 IF ASUMV("MODE")=0
SET ASUV("MSG")="INVENTORY NOT BEGUN "
DO MESSAGE
QUIT
+3 IF ASUMV("MODE")=1
SET ASUV("MSG")="FIRST COUNTS NOT COMPLETED "
DO MESSAGE
QUIT
+4 SET ASUV("MSG")="RE-COUNTS COMPLETED "
DO MESSAGE
+5 IF ASUF=2
SET ASUF=1
QUIT
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 IF ASUK("PTR-Q")
QUIT
+8 SET DIR(0)="Y"
SET DIR("A")="DO YOU WANT TO RE-PRINT THE RE-COUNT LISTING? "
SET DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST"
DO ^DIR
KILL DIR
+9 IF Y
SET ASUF=0
SET ASUF("RPRN")=1
+10 QUIT
MESSAGE ;
+1 SET ASUV("MSG",1)=$GET(ASUV("MSG",1))
+2 SET ASURX="W !,"""_ASUV("MSG",1)_""",!,"""_ASUV("MSG")_"FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$GET(ASUL(9,"ACC","NM"))_" INVENTORY"""
+3 SET ASURX=ASURX_",!,""WHICH IS IN "_$SELECT(ASUMV("MODE")=0:"INITIALIZED",ASUMV("MODE")=3:"RESEARCH",ASUMV("MODE")=4:"COMPLETED",1:"FIRST COUNT")_" MODE"""
+4 IF ASUV("MSG",1)=""
Begin DoDot:1
+5 SET ASUF=2
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET ASUF=1
End DoDot:1
+8 DO V^ASUUPLOG
+9 KILL ASUV("MSG")
+10 QUIT
