ASUV3AN ; IHS/ITSC/LMH -ENTER ADJUSTMENTS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine accepts Physical Inventory 'Adjustments' data input.
D:'$D(DT) ^XBKVAR
F D I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.D ACCOUNT
.I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
.I ASUMV("E#","ASA")="" S ASUF=1 Q
.S ASUF("IDX")=1
.S DIR("A")="ENTER RESEARCH ADJUSTMENT FOR ALL ITEMS? (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 IXLOOP
..K ASUR("RSVP")
.E D
..K ^ASUV("AX",ASUMV("E#","ASA"))
..D ASUV3AN4,ASUV3AN1 S ASUF=0
.I ASUF("IDX") D
..W !!!,"ALL RESEARCH ADJUSTMENT QUANTITIES ENTERED FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM"),!
..S DIR(0)="E" D ^DIR K DIR
K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
K DTOUT,DUOUT,DIC,DIR,X,Y
Q
ASUV3AN0 ;EP ; CHECK
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)>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 RESEARCHED -RESEARCH NOT MARKED AS COMPLETE"""
.D V^ASUUPLOG
G XIT1
FLAGIT4 ;EP ;SET FLAGS
S ASURX="W !,""ALL ITEMS HAVE BEEN RESEARCHED -RESEARCH MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT "_ASUMV("ACC")_" "
D:$G(ASUL(9,"ACC","NM"))="" ACC^ASULDIRF(ASUMV("ACC"))
S ASURX=ASURX_ASUL(9,"ACC","NM")_" IS NOW IN COMPLETED MODE"""
D V^ASUUPLOG
S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=4
XIT1 ;
Q
ACCOUNT ;
I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G XIT1
D CLS^ASUUHDG
S DIC("A")="ENTER RESEARCH ADJUSTED QUANTITIES FOR WHAT ACCOUNT? "
S DIC="9002039.09",DIC(0)="AMEZQ"
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT)) Q
I '$D(Y) S ASUF=1 Q
I Y>0 D
.S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
E D
.S ASUMV("E#","ASA")=ASUL(2,"STA","E#"),ASUF=1
Q:ASUMV("E#","ASA")=""
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 ;
D
.I ASUMV("MODE")=3 S ASUF=0 K ^ASUV("AX",ASUMV("E#","ASA")) D ASUV3AN4 Q
.I ASUMV("MODE")=0 S ASUF=2,ASUV("MSG",2)="""INVENTORY" D MESSAGE Q
.I ASUMV("MODE")=1 S ASUF=2,ASUV("MSG",2)="""FIRST COUNTS" D MESSAGE Q
.I ASUMV("MODE")=2 S ASUF=2,ASUV("MSG",2)="""RE-COUNTS" D MESSAGE Q
.S ASUF=1,ASUV("MSG",2)="!,""RESEARCH COMPLETED FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"
.S ASUV("MSG")="!,""WHICH IS IN COMPLETED MODE"""
.D MESSAGE2
I ASUF=0 Q
I ASUF=2 S ASUF=1 Q
Q:$D(DTOUT)!($D(DUOUT))
Q:$G(ASUK("PTR-Q"))
S DIR(0)="Y",DIR("A")="DO YOU WANT TO RE-PRINT THE ADJUSTMENT DOCUMENT? ",DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST" D ^DIR K DIR
I Y D
.S ASUF=0,ASUF("RPRN")=1
E D
.S ASUF=1
Q
MESSAGE ;
S ASUV("MSG")=ASUV("MSG",2)_" NOT "_$S(ASUMV("MODE")=0:"BEGUN",1:"COMPLETED")_" FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"",!,""RESEARCH NOT ALLOWED"""
S ASUV("MSG",1)=$G(ASUV("MSG",1))
I ASUV("MSG",1)']"" D
.S ASUV("MSG",1)="W !,"
E D
.S ASUV("MSG",1)="W !,"""_ASUV("MSG",1)_""",!,"
S ASURX=ASUV("MSG",1)_ASUV("MSG")
D V^ASUUPLOG
Q
MESSAGE2 ;
S ASUV("MSG",1)=$G(ASUV("MSG",1))
S ASURX="W !,"""_ASUV("MSG",1)_""","_ASUV("MSG",2)_""""
I ASUV("MSG",1)="" D
.S ASUF=2
E D
.S ASUF=1
D V^ASUUPLOG
Q
ASUV3AN1 ;
S ASUR("ACC")=ASUMV("ACC")
F D I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
.W ! D ^ASUV9IDX I $D(DTOUT)!($D(DUOUT)) Q
.I ASUMX("E#","IDX")="" S ASUF=1 Q
.D READ^ASUMXDIO
.S ASUMV("E#","IDX")=ASUMX("IDX")
.I '$D(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"))) D
..W !,"NO ADJUSTMENT NEEDED FOR THIS INDEX"
.E D
..D STALOOP
Q
IXLOOP ;EP
S ASUMV("E#","IDX")=0
F S ASUMV("E#","IDX")=$O(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"))) Q:ASUMV("E#","IDX")']"" D STALOOP Q:$D(DTOUT) Q:$D(DUOUT)
Q
STALOOP ;
S ASUL(2,"STA","E#")=0
F S ASUL(2,"STA","E#")=$O(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#"))) Q:ASUL(2,"STA","E#")']"" D ASUV3AN2 Q:$D(DTOUT) Q:$D(DUOUT)
Q
ASUV3AN2 ;
S ASUMV(0,2)=^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#"))
S ASUMV("E#","SLC")=$P(ASUMV(0,2),U)
S ASUMV("E#","INDX")=$P(ASUMV(0,2),U,2)
D ^ASUV9IMR
D READ^ASUMXDIO
S ASUMV("VAL","DIF")=ASUMV("QTY","DIF")*ASUMV("U/C")
I +ASUMV("QTY","DIF")>1!(ASUMV("QTY","DIF")<-1) D
.I ASUMV("VAL","DIF")'<25!(ASUMV("VAL","DIF")<-25) D
..S ASUF("IDX")=0
..I ASUR("RSVP")="Y" W !!,"INDEX : ",ASUMX("IDX")
..S ASUMS("STA")=$P(^ASUMS(ASUMV("STA"),0),U)
..W:ASUR("RSVP")="Y" ?15,ASUMX("DESC",1)
..W ?65,"STATION : ",ASUMS("STA")
..S DIR("B")=ASUMV("ADJQTY")
..S DIR("A")="ENTER RSCH/ADJ MASTER QUANTITY"
..S DIR(0)="NO^0:999999:0^K:X[""."" X" D ^DIR K DIR
..I $D(DTOUT)!($D(DUOUT)) Q
..S ASUR("QTY")=X
..I ASUR("QTY")="" Q
..S ASUMV("ADJQTY")=ASUR("QTY")
..S ASUMV("QTY","DIF")=ASUMV("CNT","2ND")-ASUR("QTY")
..S ASUMV("CNT-ENT")=3
E D
.S ASUMV("CNT-ENT")=4
.Q:ASUR("RSVP")="Y"
.W !,"DIFFERENCE LESS THAN 1 OR VALUE LESS THAN $25.00 -NO RESEARCH COUNTS"
.S DIR(0)="E" D ^DIR K DIR
.S ASUMV("IDX")=""
D ^ASUV9IMW
Q
ASUV3AN4 ;
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
.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
..S ASUF("QU")=0
..D ^ASUV9IMR
..I $G(ASUR("RSVP"))="N" D
...I ASUMV("QTY","DIF")=0 D Q:ASUF("QU")
....I ASUMV("QTY","STAM")'=0 S ASUF("QU")=1 Q
....I ASUMV("ADJQTY")=0 S ASUF("QU")=1 Q
....I ASUMV("CNT","2ND")=0 S ASUF("QU")=1 Q
....I ASUMV("CNT","1ST")=0 S ASUF("QU")=1 Q
..;I ASUMV("CNT-ENT")>2 S ASUF("QU")=1 Q ;ADJUSTMENT ALREADY ENTERED
..I ASUF("QU")=0 D
...S ASUF("IDX")=0
...S ^ASUV("AX",ASUMV("E#","ASA"),ASUMV("IDX"),ASUMV("STA"))=ASUMV("E#","SLC")_U_ASUMV("E#","INDX")
Q
ASUV3AN ; IHS/ITSC/LMH -ENTER ADJUSTMENTS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine accepts Physical Inventory 'Adjustments' data input.
+3 IF '$DATA(DT)
DO ^XBKVAR
+4 FOR
Begin DoDot:1
+5 DO ACCOUNT
+6 IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+7 IF ASUMV("E#","ASA")=""
SET ASUF=1
QUIT
+8 SET ASUF("IDX")=1
+9 SET DIR("A")="ENTER RESEARCH ADJUSTMENT FOR ALL ITEMS? (Y/N) "
+10 SET DIR("B")="Y"
+11 SET DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select items or '^' to exit"
+12 SET DIR(0)="SA^Y:Yes;N:No"
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+15 SET ASUR("RSVP")=$EXTRACT(Y)
+16 IF ASUR("RSVP")="Y"
Begin DoDot:2
+17 DO IXLOOP
+18 KILL ASUR("RSVP")
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 KILL ^ASUV("AX",ASUMV("E#","ASA"))
+21 DO ASUV3AN4
DO ASUV3AN1
SET ASUF=0
End DoDot:2
+22 IF ASUF("IDX")
Begin DoDot:2
+23 WRITE !!!,"ALL RESEARCH ADJUSTMENT QUANTITIES ENTERED FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM"),!
+24 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))!($GET(ASUF)>0)
QUIT
+25 KILL ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
+26 KILL DTOUT,DUOUT,DIC,DIR,X,Y
+27 QUIT
ASUV3AN0 ;EP ; CHECK
+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("QTY","DIF")=0
QUIT
+11 IF ASUMV("CNT-ENT")>2
QUIT
+12 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
+13 IF ASUF=1
Begin DoDot:1
+14 SET ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN RESEARCHED -RESEARCH NOT MARKED AS COMPLETE"""
+15 DO V^ASUUPLOG
End DoDot:1
+16 GOTO XIT1
FLAGIT4 ;EP ;SET FLAGS
+1 SET ASURX="W !,""ALL ITEMS HAVE BEEN RESEARCHED -RESEARCH MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT "_ASUMV("ACC")_" "
+2 IF $GET(ASUL(9,"ACC","NM"))=""
DO ACC^ASULDIRF(ASUMV("ACC"))
+3 SET ASURX=ASURX_ASUL(9,"ACC","NM")_" IS NOW IN COMPLETED MODE"""
+4 DO V^ASUUPLOG
+5 SET $PIECE(^ASUMV(ASUMV("E#","ASA"),0),U,4)=4
XIT1 ;
+1 QUIT
ACCOUNT ;
+1 IF $GET(ASUL(2,"STA","E#"))']""
DO STA^ASUV0NT
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO XIT1
+2 DO CLS^ASUUHDG
+3 SET DIC("A")="ENTER RESEARCH ADJUSTED QUANTITIES 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)
SET ASUF=1
QUIT
+8 IF Y>0
Begin DoDot:1
+9 SET ASUMV("ACC")=$PIECE(Y,U)
SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
SET ASUF=1
End DoDot:1
+12 IF ASUMV("E#","ASA")=""
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 ;
+1 Begin DoDot:1
+2 IF ASUMV("MODE")=3
SET ASUF=0
KILL ^ASUV("AX",ASUMV("E#","ASA"))
DO ASUV3AN4
QUIT
+3 IF ASUMV("MODE")=0
SET ASUF=2
SET ASUV("MSG",2)="""INVENTORY"
DO MESSAGE
QUIT
+4 IF ASUMV("MODE")=1
SET ASUF=2
SET ASUV("MSG",2)="""FIRST COUNTS"
DO MESSAGE
QUIT
+5 IF ASUMV("MODE")=2
SET ASUF=2
SET ASUV("MSG",2)="""RE-COUNTS"
DO MESSAGE
QUIT
+6 SET ASUF=1
SET ASUV("MSG",2)="!,""RESEARCH COMPLETED FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"
+7 SET ASUV("MSG")="!,""WHICH IS IN COMPLETED MODE"""
+8 DO MESSAGE2
End DoDot:1
+9 IF ASUF=0
QUIT
+10 IF ASUF=2
SET ASUF=1
QUIT
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 IF $GET(ASUK("PTR-Q"))
QUIT
+13 SET DIR(0)="Y"
SET DIR("A")="DO YOU WANT TO RE-PRINT THE ADJUSTMENT DOCUMENT? "
SET DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST"
DO ^DIR
KILL DIR
+14 IF Y
Begin DoDot:1
+15 SET ASUF=0
SET ASUF("RPRN")=1
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET ASUF=1
End DoDot:1
+18 QUIT
MESSAGE ;
+1 SET ASUV("MSG")=ASUV("MSG",2)_" NOT "_$SELECT(ASUMV("MODE")=0:"BEGUN",1:"COMPLETED")_" FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"",!,""RESEARCH NOT ALLOWED"""
+2 SET ASUV("MSG",1)=$GET(ASUV("MSG",1))
+3 IF ASUV("MSG",1)']""
Begin DoDot:1
+4 SET ASUV("MSG",1)="W !,"
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET ASUV("MSG",1)="W !,"""_ASUV("MSG",1)_""",!,"
End DoDot:1
+7 SET ASURX=ASUV("MSG",1)_ASUV("MSG")
+8 DO V^ASUUPLOG
+9 QUIT
MESSAGE2 ;
+1 SET ASUV("MSG",1)=$GET(ASUV("MSG",1))
+2 SET ASURX="W !,"""_ASUV("MSG",1)_""","_ASUV("MSG",2)_""""
+3 IF ASUV("MSG",1)=""
Begin DoDot:1
+4 SET ASUF=2
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET ASUF=1
End DoDot:1
+7 DO V^ASUUPLOG
+8 QUIT
ASUV3AN1 ;
+1 SET ASUR("ACC")=ASUMV("ACC")
+2 FOR
Begin DoDot:1
+3 WRITE !
DO ^ASUV9IDX
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+4 IF ASUMX("E#","IDX")=""
SET ASUF=1
QUIT
+5 DO READ^ASUMXDIO
+6 SET ASUMV("E#","IDX")=ASUMX("IDX")
+7 IF '$DATA(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX")))
Begin DoDot:2
+8 WRITE !,"NO ADJUSTMENT NEEDED FOR THIS INDEX"
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 DO STALOOP
End DoDot:2
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(ASUF)>0)
QUIT
+11 QUIT
IXLOOP ;EP
+1 SET ASUMV("E#","IDX")=0
+2 FOR
SET ASUMV("E#","IDX")=$ORDER(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX")))
IF ASUMV("E#","IDX")']""
QUIT
DO STALOOP
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+3 QUIT
STALOOP ;
+1 SET ASUL(2,"STA","E#")=0
+2 FOR
SET ASUL(2,"STA","E#")=$ORDER(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#")))
IF ASUL(2,"STA","E#")']""
QUIT
DO ASUV3AN2
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+3 QUIT
ASUV3AN2 ;
+1 SET ASUMV(0,2)=^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#"))
+2 SET ASUMV("E#","SLC")=$PIECE(ASUMV(0,2),U)
+3 SET ASUMV("E#","INDX")=$PIECE(ASUMV(0,2),U,2)
+4 DO ^ASUV9IMR
+5 DO READ^ASUMXDIO
+6 SET ASUMV("VAL","DIF")=ASUMV("QTY","DIF")*ASUMV("U/C")
+7 IF +ASUMV("QTY","DIF")>1!(ASUMV("QTY","DIF")<-1)
Begin DoDot:1
+8 IF ASUMV("VAL","DIF")'<25!(ASUMV("VAL","DIF")<-25)
Begin DoDot:2
+9 SET ASUF("IDX")=0
+10 IF ASUR("RSVP")="Y"
WRITE !!,"INDEX : ",ASUMX("IDX")
+11 SET ASUMS("STA")=$PIECE(^ASUMS(ASUMV("STA"),0),U)
+12 IF ASUR("RSVP")="Y"
WRITE ?15,ASUMX("DESC",1)
+13 WRITE ?65,"STATION : ",ASUMS("STA")
+14 SET DIR("B")=ASUMV("ADJQTY")
+15 SET DIR("A")="ENTER RSCH/ADJ MASTER QUANTITY"
+16 SET DIR(0)="NO^0:999999:0^K:X[""."" X"
DO ^DIR
KILL DIR
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+18 SET ASUR("QTY")=X
+19 IF ASUR("QTY")=""
QUIT
+20 SET ASUMV("ADJQTY")=ASUR("QTY")
+21 SET ASUMV("QTY","DIF")=ASUMV("CNT","2ND")-ASUR("QTY")
+22 SET ASUMV("CNT-ENT")=3
End DoDot:2
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 SET ASUMV("CNT-ENT")=4
+25 IF ASUR("RSVP")="Y"
QUIT
+26 WRITE !,"DIFFERENCE LESS THAN 1 OR VALUE LESS THAN $25.00 -NO RESEARCH COUNTS"
+27 SET DIR(0)="E"
DO ^DIR
KILL DIR
+28 SET ASUMV("IDX")=""
End DoDot:1
+29 DO ^ASUV9IMW
+30 QUIT
ASUV3AN4 ;
+1 SET ASUMV("E#","SLC")=0
+2 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:1
+3 SET ASUMV("E#","INDX")=0
+4 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
+5 SET ASUF("QU")=0
+6 DO ^ASUV9IMR
+7 IF $GET(ASUR("RSVP"))="N"
Begin DoDot:3
+8 IF ASUMV("QTY","DIF")=0
Begin DoDot:4
+9 IF ASUMV("QTY","STAM")'=0
SET ASUF("QU")=1
QUIT
+10 IF ASUMV("ADJQTY")=0
SET ASUF("QU")=1
QUIT
+11 IF ASUMV("CNT","2ND")=0
SET ASUF("QU")=1
QUIT
+12 IF ASUMV("CNT","1ST")=0
SET ASUF("QU")=1
QUIT
End DoDot:4
IF ASUF("QU")
QUIT
End DoDot:3
+13 ;I ASUMV("CNT-ENT")>2 S ASUF("QU")=1 Q ;ADJUSTMENT ALREADY ENTERED
+14 IF ASUF("QU")=0
Begin DoDot:3
+15 SET ASUF("IDX")=0
+16 SET ^ASUV("AX",ASUMV("E#","ASA"),ASUMV("IDX"),ASUMV("STA"))=ASUMV("E#","SLC")_U_ASUMV("E#","INDX")
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
