ASUV1PN ; IHS/ITSC/LMH -ENTER 1ST COUNTS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine accepts Physical Inventory 'First Count' data input.
D:'$D(DT) ^XBKVAR
ACCOUNT ;
F D Q:$D(DUOUT) Q:$D(DTOUT) Q:$G(ASUF)>0
.D ACCT
.I $D(DUOUT)!($D(DTOUT)) Q
.Q:$G(ASUF)>0
.I ASUMV("E#","ASA")="" S ASUF=1 Q
.S DIR("A")="ENTER COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
.S DIR("B")="Y"
.S DIR("?")="Enter 'Y' to enter 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
..D ASUV1PN3
K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
K DTOUT,DUOUT,DIC,DIR,X,Y
Q
ASUV1PN0 ;EP ;
D CKIT
G:($G(ASUF)>0)!($D(DTOUT))!($D(DUOUT)) XIT1
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)]"" Q
..D INDEX^ASUV9IMR
..Q:ASUMV("IDX")["*" ;MASTER HAS BEEN DELETED
..I ASUMV("CNT-ENT")=1 Q
..S ASUF=1
I ASUF=1 D
.S ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN COUNTED -FIRST COUNT NOT MARKED AS COMPLETE"""
.D V^ASUUPLOG
G XIT1
FLAGIT1 ;EP;
S ASURX="W !,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN FIRST COUNT MODE"""
D V^ASUUPLOG
S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=1
G XIT1
FLAGIT2 ;EP;
S ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED ONCE -FIRST COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN RE-COUNT MODE"""
D V^ASUUPLOG
S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=2
XIT1 ;
Q
ACCT ;EP;ACCOUNT
D CLS^ASUUHDG
S DIC("A")="ENTER 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")_"' -"_ASUL(9,"ACC","NM")_"""",ASUF=1
.D V^ASUUPLOG
G XIT1
CKIT ;EP;
I ASUMV("MODE")=1 S ASUF=0 Q
I ASUMV("MODE")=0 S ASUV("MSG")="INITIAL INVENTORY LIST HAS NOT YET BEEN CREATED " D MESSAGE Q
S ASUV("MSG")="FIRST COUNTS ARE ALREADY COMPLETED " D MESSAGE
D REPRINT
Q
CKINIT ;EP;
I ASUMV("MODE")=0 S ASUF=0 Q
S ASUV("MSG")="INVENTORY HAS ALREADY BEGUN " D MESSAGE
REPRINT ;
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")_"' -"_ASUL(9,"ACC","NM")_" INVENTORY"""
S ASURX=ASURX_",!,""WHICH IS IN "_$S(ASUMV("MODE")=1:"FIRST COUNT",ASUMV("MODE")=2:"RECOUNT",ASUMV("MODE")=3:"RESEARCH",1:"COMPLETED")_" MODE"""
I ASUV("MSG",1)="" D
.S ASUF=2
E D
.S ASUF=1
K ASUV("MSG")
D V^ASUUPLOG
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
.D CLS^ASUUHDG
.S ASUF("IDX")=0
.D IDXLOOP
D
.I ASUF("SLC") W !,"ALL COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!! Q
.I 'ASUF("IDX") W !,"ALL RECOUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -",ASUMV("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 ASUV1PN2
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
ASUV1PN2 ;
I ASUMV("E#","INDX")'?1N.N G XIT2
D INDEX^ASUV9IMR
Q:ASUMV("IDX")["*" ;MASTER HAS BEEN DELETED
D READ^ASUMXDIO
I ASUMV("CNT-ENT")=1,ASUF("IDX")<2 G XIT2
D:$G(ASUMV("SLC"))']"" STORLOC^ASUV9IMR
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")
S DIR("B")=$S(ASUMV("CNT","1ST")>0:ASUMV("CNT","1ST"),1:"")
S DIR("A")="ENTER INVENTORY QUANTITY COUNT"
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","1ST")=ASUR("QTY")
S ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
S ASUMV("CNT-ENT")=1
D INDEX^ASUV9IMW
XIT2 ;
Q
ASUV1PN3 ;
S ASUR("ACC")=ASUMV("ACC")
F D I $D(DUOUT)!($D(DTOUT))!$G(ASUF)]"" Q
.S DIC("A")="ENTER 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 ",ASUV("SL NM")," '",ASUR("SLC"),"' IN ACCOUNT ",ASUL(9,"ACC","NM")," INVENTORY MASTER"
..D PAUSE
.E D
..S DIR("A")="ENTER COUNTS FOR ALL ITEMS? (Y/N) "
..S DIR("B")="Y"
..S DIR("?")="Enter 'Y' to enter counts for all items or 'N' to select item to enter 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 Q
...S ASUF("IDX")=0
...D IDXLOOP
...I ASUF("IDX")=0 W !,"ALL ",ASUV("SL NM")," '",ASUR("SLC"),"' ITEM COUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM") D PAUSE
..E D
...D RDINDX
.S ASUF=0
S ASUF=0
Q
RDINDX ;
F D I $D(DUOUT)!($D(DTOUT))!$G(ASUF)]"" 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 ASUV1PN2
..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
ASUV1PN ; IHS/ITSC/LMH -ENTER 1ST COUNTS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine accepts Physical Inventory 'First Count' data input.
+3 IF '$DATA(DT)
DO ^XBKVAR
ACCOUNT ;
+1 FOR
Begin DoDot:1
+2 DO ACCT
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+4 IF $GET(ASUF)>0
QUIT
+5 IF ASUMV("E#","ASA")=""
SET ASUF=1
QUIT
+6 SET DIR("A")="ENTER COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
+7 SET DIR("B")="Y"
+8 SET DIR("?")="Enter 'Y' to enter counts for all items or 'N' to select items or '^' to exit"
+9 SET DIR(0)="SA^Y:Yes;N:No"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+12 SET ASUR("RSVP")=$EXTRACT(Y)
+13 IF ASUR("RSVP")="Y"
Begin DoDot:2
+14 DO SLCLOOP
+15 KILL ASUR("RSVP")
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 DO ASUV1PN3
End DoDot:2
End DoDot:1
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
IF $GET(ASUF)>0
QUIT
+18 KILL ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
+19 KILL DTOUT,DUOUT,DIC,DIR,X,Y
+20 QUIT
ASUV1PN0 ;EP ;
+1 DO CKIT
+2 IF ($GET(ASUF)>0)!($DATA(DTOUT))!($DATA(DUOUT))
GOTO XIT1
+3 SET ASUMV("E#","SLC")=0
+4 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:1
+5 DO STORLOC^ASUV9IMR
+6 SET ASUMV("E#","INDX")=0
+7 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
+8 DO INDEX^ASUV9IMR
+9 ;MASTER HAS BEEN DELETED
IF ASUMV("IDX")["*"
QUIT
+10 IF ASUMV("CNT-ENT")=1
QUIT
+11 SET ASUF=1
End DoDot:2
IF $DATA(DTOUT)!($DATA(DUOUT))!$GET(ASUF)]""
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 COUNTED -FIRST COUNT NOT MARKED AS COMPLETE"""
+14 DO V^ASUUPLOG
End DoDot:1
+15 GOTO XIT1
FLAGIT1 ;EP;
+1 SET ASURX="W !,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN FIRST COUNT MODE"""
+2 DO V^ASUUPLOG
+3 SET $PIECE(^ASUMV(ASUMV("E#","ASA"),0),U,4)=1
+4 GOTO XIT1
FLAGIT2 ;EP;
+1 SET ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED ONCE -FIRST COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN RE-COUNT MODE"""
+2 DO V^ASUUPLOG
+3 SET $PIECE(^ASUMV(ASUMV("E#","ASA"),0),U,4)=2
XIT1 ;
+1 QUIT
ACCT ;EP;ACCOUNT
+1 DO CLS^ASUUHDG
+2 SET DIC("A")="ENTER COUNTS FOR WHAT ACCOUNT? "
+3 SET DIC="9002039.09"
SET DIC(0)="AMEZQ"
+4 DO ^DIC
KILL DIC
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 IF '$DATA(Y)
QUIT
+7 IF Y>0
Begin DoDot:1
+8 SET ASUF=0
+9 SET ASUMV("ACC")=$PIECE(Y,U)
SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
+10 DO ACC^ASULDIRF(ASUMV("ACC"))
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
SET ASUF=1
End DoDot:1
QUIT
+13 IF $DATA(^ASUMV(ASUMV("E#","ASA"),0))
Begin DoDot:1
+14 DO ACCOUNT^ASUV9IMR
DO CKIT
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET ASURX="W !,""NO INVENTORY ACTIVE FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_""""
SET ASUF=1
+17 DO V^ASUUPLOG
End DoDot:1
+18 GOTO XIT1
CKIT ;EP;
+1 IF ASUMV("MODE")=1
SET ASUF=0
QUIT
+2 IF ASUMV("MODE")=0
SET ASUV("MSG")="INITIAL INVENTORY LIST HAS NOT YET BEEN CREATED "
DO MESSAGE
QUIT
+3 SET ASUV("MSG")="FIRST COUNTS ARE ALREADY COMPLETED "
DO MESSAGE
+4 DO REPRINT
+5 QUIT
CKINIT ;EP;
+1 IF ASUMV("MODE")=0
SET ASUF=0
QUIT
+2 SET ASUV("MSG")="INVENTORY HAS ALREADY BEGUN "
DO MESSAGE
REPRINT ;
+1 IF ASUF=2
SET ASUF=1
QUIT
+2 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+3 IF ASUK("PTR-Q")
QUIT
+4 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"
+5 DO ^DIR
KILL DIR
+6 IF Y
SET ASUF=0
SET ASUF("RPRN")=1
+7 QUIT
MESSAGE ;
+1 SET ASUV("MSG",1)=$GET(ASUV("MSG",1))
+2 SET ASURX="W !,"""_ASUV("MSG",1)_""",!,"""_ASUV("MSG")_"FOR "_""",!,"""_"ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" INVENTORY"""
+3 SET ASURX=ASURX_",!,""WHICH IS IN "_$SELECT(ASUMV("MODE")=1:"FIRST COUNT",ASUMV("MODE")=2:"RECOUNT",ASUMV("MODE")=3:"RESEARCH",1:"COMPLETED")_" 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 KILL ASUV("MSG")
+9 DO V^ASUUPLOG
+10 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 DO CLS^ASUUHDG
+8 SET ASUF("IDX")=0
+9 DO IDXLOOP
End DoDot:1
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+10 Begin DoDot:1
+11 IF ASUF("SLC")
WRITE !,"ALL COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!!
QUIT
+12 IF 'ASUF("IDX")
WRITE !,"ALL RECOUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -",ASUMV("SL NM")," HAVE BEEN ENTERED",!!!
End DoDot:1
+13 SET DIR(0)="E"
DO ^DIR
KILL DIR
+14 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 ASUV1PN2
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
ASUV1PN2 ;
+1 IF ASUMV("E#","INDX")'?1N.N
GOTO XIT2
+2 DO INDEX^ASUV9IMR
+3 ;MASTER HAS BEEN DELETED
IF ASUMV("IDX")["*"
QUIT
+4 DO READ^ASUMXDIO
+5 IF ASUMV("CNT-ENT")=1
IF ASUF("IDX")<2
GOTO XIT2
+6 IF $GET(ASUMV("SLC"))']""
DO STORLOC^ASUV9IMR
+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 SET DIR("B")=$SELECT(ASUMV("CNT","1ST")>0:ASUMV("CNT","1ST"),1:"")
+13 SET DIR("A")="ENTER INVENTORY QUANTITY COUNT"
+14 SET DIR(0)="NO^0:999999:0^K:X[""."" X"
DO ^DIR
KILL DIR
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO XIT2
+16 SET ASUR("QTY")=X
+17 IF ASUR("QTY")=""
GOTO XIT2
+18 SET ASUMV("CNT","1ST")=ASUR("QTY")
+19 SET ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
+20 SET ASUMV("CNT-ENT")=1
+21 DO INDEX^ASUV9IMW
XIT2 ;
+1 QUIT
ASUV1PN3 ;
+1 SET ASUR("ACC")=ASUMV("ACC")
+2 FOR
Begin DoDot:1
+3 SET DIC("A")="ENTER 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 ",ASUV("SL NM")," '",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 COUNTS FOR ALL ITEMS? (Y/N) "
+15 SET DIR("B")="Y"
+16 SET DIR("?")="Enter 'Y' to enter counts for all items or 'N' to select item to enter 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 ",ASUV("SL NM")," '",ASUR("SLC"),"' ITEM COUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM")
DO PAUSE
End DoDot:3
QUIT
+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)]""
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 ASUV1PN2
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)]""
QUIT
+13 SET ASUF=0
+14 QUIT
PAUSE ;
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 QUIT
