ACRFRR ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND SELECT DOCUMENTS FOR RECEIVING REPORT OR INVICE AUDIT; [ 04/02/2007 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20,22**;NOV 05, 2001
;;ROUTINE USED TO DISPLAY AND SELECT DOCUMENTS FOR RECEIVING REPORT
;;OR INVOICE AUDIT
EN ;I '$D(ACRIV)#2 D SHIPTO Q:$D(ACRQUIT)!$D(ACROUT)!(Y<1)
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRSS,ACRTXOBJ,ACRQUIT,ACRPO,ACRRR,ACRXX,ACRFINAL,ACRMAX,ACRPVN,ACRPAYDU,^TMP("ACRRR",$J)
Q
SHIPTO ;EP;TO SELECT SHIP TO DEPARTMENT FOR DUE IN & RECEIVING REPORTS
S DIC="^AUTTPRG("
S DIC("A")="Select Receiving Location: "
S DIC(0)="AEMQZ"
S DIC("S")="I $D(^ACRDOC(""DI"",+Y))"
W !!
D DIC^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(Y<1)
S ACRRL=+Y
Q
EN1 ;EP;SELECT PURCHASE ORDER FOR RECEIVING ACTION
K ACRPVN
W @IOF
W !?20,"SELECT DOCUMENT FOR ",$S('$D(ACRIV)#2:"RECEIVING ACTION",1:"INVOICE AUDIT")
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")="Requisition/PO NO.: "
I '$D(ACRIV)#2 D I 1
.S DIC("S")="I $D(^ACRSS(""J"",+Y)) S ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRDOC=^ACRDOC(+Y,0),ACRREF=$P(ACRDOC,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U)"
.S DIC("S")=DIC("S")_" I ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210),$P(ACRDOC,U,4)'=35,'$P(ACRDOC,U,18),$P(ACRAPV,U)=""A"",$P(ACRAPV,U,8)=""A"""
I $D(ACRIV)#2 D
.S DIC("S")="I $P($G(^ACRDOC(+Y,""PO"")),U,5)!+$G(^(""TRNG3"")) S ACRDOC=^(0),ACRREF=$P(ACRDOC,U,13),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P($G(^AUTTDOCR(+ACRREF,0)),U)"
.S DIC("S")=DIC("S")_" I ""^103^204^349^326^210^""[(U_ACRREF_U)!$P(ACRDOC,U,19),$P(ACRAPV,U,8)=""A"""
W !!
D DIC^ACRFDIC
I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
S ACRDOCDA=+Y
I $P($G(^ACROBL(ACRDOCDA,"APV")),U,9)=1 D Q
.W !!,"Final INVOICE AUDIT has been completed for this document."
.D PAUSE^ACRFWARN
.K ACRQUIT
D SETDOC^ACRFEA1
S ACRRRNO=$P(ACRDOCPO,U,21)
I '$D(ACRIV)#2,$P($G(^ACROBL(ACRDOCDA,"APV")),U,6)=1 D I $D(ACRQUIT) K ACRQUIT Q
.I '$D(^ACRRR("AC",ACRDOCDA))&'$D(^ACRRR("C",ACRDOCDA)) D Q
..S DA=ACRDOCDA
..S DIE="^ACROBL("
..S DR="909///@"
..D DIE^ACRFDIC
..K ACRQUIT
.W *7,*7
.W !!,"The document selected above ID NO.: ",ACRDOCDA," is identified"
.W !,"as having a 'FINAL' Receiving Report on file. Use the 'PD' Print Document"
.W !,"function to print a copy of the Receiving Report or contact your ARMS manager"
.W !,"to re-open the document if further receiving action is required"
.D PAUSE^ACRFWARN
.S ACRQUIT=""
I $D(ACRIV)#2 D I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
.D VENDOR
.Q:$D(ACRQUIT)!$D(ACROUT)
D ^ACRFRR1
Q
ACRRR ;EP;
K ACRIV
S ACRRR=""
G EN
ACRIV ;EP;
K ACRRR
S ACRIV=""
G EN
VENDOR ;EP;FOR FINANCE TO REVIEW AND EDIT VENDOR DATA
F D V1 Q:$D(ACRQUIT)!$D(ACROUT)
;K ACRQUIT ;ACR*2.1*22.17
K:$G(ACRQUIT)'=1 ACRQUIT ;ACR*2.1*22.17
Q
V1 D VHEAD^ACRFRR1
I 'D0 D Q
.W *7,*7
.W !!,"The VENDOR/PAYEE data is not complete for this order."
.W !,"Please refer this order to your Procurement office for resolution."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
S DIR(0)="YO"
S DIR("B")="YES"
S DIR("A",1)="Are you ABSOLUTELY CERTAIN that ALL this VENDOR DATA is correct."
S DIR("A",2)="You CANNOT change any VENDOR DATA after the payment has been recorded."
S DIR("A",3)=" "
S DIR("A")="Is the PAYEE data correct"
W !
D DIR^ACRFDIC
I +Y=1 S ACRQUIT=""
Q:$D(ACRQUIT)!$D(ACROUT)
I Y=0 D VCHANGE^ACRFRR1
Q:$D(ACRQUIT)
;S DA=$P(^ACRDOC(ACRDOCDA,5),U,5) ;ACR*2.1*22.14
S (ACRVND,DA)=$P(^ACRDOC(ACRDOCDA,5),U,5) ;ACR*2.1*22.14
S DIE="^AUTTVNDR("
S DR="[ACR VENDOR REMIT TO ADDRESS]"
D DDS^ACRFDIC
I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
Q ;ACR*2.1*22.14
;I '$P($G(^ACRAU(DUZ,1)),U,15) D Q ;ACR*2.1*22.14
S ACRVAUTH=$$EDITAUTH^ACRFVLK(DUZ) ; Get ARMS User Vendor Edit Authority;ACR*2.1*22.14
I ",A,F,"'[(","_ACRVAUTH_",") D MSG^ACRFVLK Q ;ACR*2.1*22.14
;.W @IOF,!!,"You do not have authority to edit data other than the REMIT TO ADDRESS." ;ACR*2.1*22.14
;.W !,"If other vendor data needs to be added or changed, contact the ARMS Manager" ;ACR*2.1*22.14
;.W !,"to find someone who can add or change the vendor data before processing payment." ;ACR*2.1*22.14
;.D PAUSE^ACRFWARN ;ACR*2.1*22.14
;I $P($G(^ACRAU(DUZ,1)),U,15) D Q ;ACR*2.1*22.14
W @IOF,!!,"WARNING: Vendor data is shared by many different computer systems."
W !,"Be ABSOLUTLEY CERTAIN the vendor data you are adding or changing is correct"
W !,"before making any changes."
D PAUSE^ACRFWARN
; D ADD^AUTTVLK ; ACR*2.1*20.14
D ADD^ACRFVLK ; ACR*2.1*20.14
Q
VCHNG ;NEW SUBROUTINE ;ACR*2.1*22.14
K ACRQUIT
S DIR(0)="YO"
S DIR("B")="YES"
S DIR("A")="Do you want to change the Payee to a different Vendor?"
W !
D DIR^ACRFDIC
I +Y D VCHANGE^ACRFRR1 Q
S ACRQUIT=1
Q
;
IDATE S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="113210T;103200T;103200.2T;103200.1T;2001"
W !
D DIE^ACRFDIC
S ACRDOCPO=^ACRDOC(ACRDOCDA,"PO")
S ACRIVNO=$P(ACRDOCPO,U,16)
S DA=ACRDOCDA
S DIE="^ACRDOC("
N X
S DR=";103811////"
S X=0
F S X=$O(^ACRDOC(ACRDOCDA,20,X)) Q:'X I $P(^ACRDOC(ACRDOCDA,20,X,0),U)'["NOT STATED",$P(^(0),U)]"" S DR=DR_$P(^ACRDOC(ACRDOCDA,20,X,0),U)_"," Q:$L(DR)>60
S DR="103810////"_ACRIVNO_DR
D DIE^ACRFDIC
Q
REOPEN ;EP;TO RE-OPEN A RECEIVING REPORT WHICH HAS BEEN FINANLIZED
W @IOF
W !?15,"UTILITY TO RE-OPEN FINALIZED ",$S('$D(ACRIV)#2:"RECEIVING REPORTS",1:"PAYMENT")
F D RE Q:$D(ACRQUIT)
K ACRQUIT
Q
RE ;SELECT RECEIVING REPORT DOCUMENT TO RE-OPEN
S DIC="^ACRDOC("
S DIC(0)="AEMQ"
S DIC("A")="Document NO.: "
S DIC("S")="S ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACRAPV,U,6)=1&$D(^ACRRR(""AC"",+Y))!($P(ACRAPV,U,9)=1)"
S:$D(ACRIV)#2 DIC("S")="S ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACRAPV,U,9)=1"
W !!
D DIC^ACRFDIC
K ACRAPV
I +Y<1 S ACRQUIT="" Q
Q:'$D(^ACROBL(+Y,0))!'$D(^ACROBL(+Y,"APV"))
S ACRDOCDA=+Y
S ACRDOC=$S($P(^ACRDOC(+Y,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U))
I '$D(ACRIV)#2,$P($G(^ACROBL(ACRDOCDA,"APV")),U,9)=1 N ACRIV S ACRIV=""
S DIR(0)="YO"
S DIR("A",1)="Are you certain you want to RE-OPEN Document NO. "_ACRDOC
S DIR("A")="for further "_$S('$D(ACRIV)#2:"receiving action",1:"invoice audit")
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
K ACRDR
I $D(ACRIV)#2 D Q:$D(ACRQUIT)!$D(ACROUT)
.S DIR(0)="YO"
.S DIR("A",1)="Do you also want to RE-OPEN Document NO. "_ACRDOC
.S DIR("A")="for further receiving action"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.S:Y=1 ACRDR="909////2;"
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=$G(ACRDR)_$S('$D(ACRIV)#2:"909////2",1:"912////2")
D DIE^ACRFDIC
S ACR=0
F S ACR=$O(^ACRSS("J",ACRDOCDA,ACR)) Q:'ACR I $D(^ACRSS(ACR,0)),$P(^(0),U,2)'=ACRDOCDA S ACRDOC($P(^(0),U,2))=""
S ACRDOC(ACRDOCDA)=""
S ACR=0
I '$D(ACRIV)#2!$D(ACRDR) F S ACR=$O(ACRDOC(ACR)) Q:'ACR I $D(^ACRRR("C",ACR)) D
.S ACRRRDA=0
.F S ACRRRDA=$O(^ACRRR("C",ACR,ACRRRDA)) Q:'ACRRRDA D
..S ACRRR0=$G(^ACRRR(ACRRRDA,0))
..I $P(ACRRR0,U,8)=1,$P(ACRRR0,U,11)'=1 D
...S DA=ACRRRDA
...S DIE="^ACRRR("
...S DR=".08////2"
...D DIE^ACRFDIC
W !!,ACRDOC," is now available for additional ",$S('$D(ACRIV)#2:"receiving",1:"payment")," action."
D PAUSE^ACRFWARN
Q
ACRFRR ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND SELECT DOCUMENTS FOR RECEIVING REPORT OR INVICE AUDIT; [ 04/02/2007 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20,22**;NOV 05, 2001
+2 ;;ROUTINE USED TO DISPLAY AND SELECT DOCUMENTS FOR RECEIVING REPORT
+3 ;;OR INVOICE AUDIT
EN ;I '$D(ACRIV)#2 D SHIPTO Q:$D(ACRQUIT)!$D(ACROUT)!(Y<1)
+1 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRSS,ACRTXOBJ,ACRQUIT,ACRPO,ACRRR,ACRXX,ACRFINAL,ACRMAX,ACRPVN,ACRPAYDU,^TMP("ACRRR",$JOB)
+1 QUIT
SHIPTO ;EP;TO SELECT SHIP TO DEPARTMENT FOR DUE IN & RECEIVING REPORTS
+1 SET DIC="^AUTTPRG("
+2 SET DIC("A")="Select Receiving Location: "
+3 SET DIC(0)="AEMQZ"
+4 SET DIC("S")="I $D(^ACRDOC(""DI"",+Y))"
+5 WRITE !!
+6 DO DIC^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(Y<1)
QUIT
+8 SET ACRRL=+Y
+9 QUIT
EN1 ;EP;SELECT PURCHASE ORDER FOR RECEIVING ACTION
+1 KILL ACRPVN
+2 WRITE @IOF
+3 WRITE !?20,"SELECT DOCUMENT FOR ",$SELECT('$DATA(ACRIV)#2:"RECEIVING ACTION",1:"INVOICE AUDIT")
+4 SET DIC="^ACRDOC("
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Requisition/PO NO.: "
+7 IF '$DATA(ACRIV)#2
Begin DoDot:1
+8 SET DIC("S")="I $D(^ACRSS(""J"",+Y)) S ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRDOC=^ACRDOC(+Y,0),ACRREF=$P(ACRDOC,U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U)"
+9 SET DIC("S")=DIC("S")_" I ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210),$P(ACRDOC,U,4)'=35,'$P(ACRDOC,U,18),$P(ACRAPV,U)=""A"",$P(ACRAPV,U,8)=""A"""
End DoDot:1
IF 1
+10 IF $DATA(ACRIV)#2
Begin DoDot:1
+11 SET DIC("S")="I $P($G(^ACRDOC(+Y,""PO"")),U,5)!+$G(^(""TRNG3"")) S ACRDOC=^(0),ACRREF=$P(ACRDOC,U,13),ACRAPV=$G(^ACROBL(+Y,""APV"")),ACRREF=$P($G(^AUTTDOCR(+ACRREF,0)),U)"
+12 SET DIC("S")=DIC("S")_" I ""^103^204^349^326^210^""[(U_ACRREF_U)!$P(ACRDOC,U,19),$P(ACRAPV,U,8)=""A"""
End DoDot:1
+13 WRITE !!
+14 DO DIC^ACRFDIC
+15 IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)
SET ACRQUIT=""
QUIT
+16 SET ACRDOCDA=+Y
+17 IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,9)=1
Begin DoDot:1
+18 WRITE !!,"Final INVOICE AUDIT has been completed for this document."
+19 DO PAUSE^ACRFWARN
+20 KILL ACRQUIT
End DoDot:1
QUIT
+21 DO SETDOC^ACRFEA1
+22 SET ACRRRNO=$PIECE(ACRDOCPO,U,21)
+23 IF '$DATA(ACRIV)#2
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,6)=1
Begin DoDot:1
+24 IF '$DATA(^ACRRR("AC",ACRDOCDA))&'$DATA(^ACRRR("C",ACRDOCDA))
Begin DoDot:2
+25 SET DA=ACRDOCDA
+26 SET DIE="^ACROBL("
+27 SET DR="909///@"
+28 DO DIE^ACRFDIC
+29 KILL ACRQUIT
End DoDot:2
QUIT
+30 WRITE *7,*7
+31 WRITE !!,"The document selected above ID NO.: ",ACRDOCDA," is identified"
+32 WRITE !,"as having a 'FINAL' Receiving Report on file. Use the 'PD' Print Document"
+33 WRITE !,"function to print a copy of the Receiving Report or contact your ARMS manager"
+34 WRITE !,"to re-open the document if further receiving action is required"
+35 DO PAUSE^ACRFWARN
+36 SET ACRQUIT=""
End DoDot:1
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+37 IF $DATA(ACRIV)#2
Begin DoDot:1
+38 DO VENDOR
+39 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+40 DO ^ACRFRR1
+41 QUIT
ACRRR ;EP;
+1 KILL ACRIV
+2 SET ACRRR=""
+3 GOTO EN
ACRIV ;EP;
+1 KILL ACRRR
+2 SET ACRIV=""
+3 GOTO EN
VENDOR ;EP;FOR FINANCE TO REVIEW AND EDIT VENDOR DATA
+1 FOR
DO V1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 ;K ACRQUIT ;ACR*2.1*22.17
+3 ;ACR*2.1*22.17
IF $GET(ACRQUIT)'=1
KILL ACRQUIT
+4 QUIT
V1 DO VHEAD^ACRFRR1
+1 IF 'D0
Begin DoDot:1
+2 WRITE *7,*7
+3 WRITE !!,"The VENDOR/PAYEE data is not complete for this order."
+4 WRITE !,"Please refer this order to your Procurement office for resolution."
+5 DO PAUSE^ACRFWARN
+6 SET ACRQUIT=""
End DoDot:1
QUIT
+7 SET DIR(0)="YO"
+8 SET DIR("B")="YES"
+9 SET DIR("A",1)="Are you ABSOLUTELY CERTAIN that ALL this VENDOR DATA is correct."
+10 SET DIR("A",2)="You CANNOT change any VENDOR DATA after the payment has been recorded."
+11 SET DIR("A",3)=" "
+12 SET DIR("A")="Is the PAYEE data correct"
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 IF +Y=1
SET ACRQUIT=""
+16 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+17 IF Y=0
DO VCHANGE^ACRFRR1
+18 IF $DATA(ACRQUIT)
QUIT
+19 ;S DA=$P(^ACRDOC(ACRDOCDA,5),U,5) ;ACR*2.1*22.14
+20 ;ACR*2.1*22.14
SET (ACRVND,DA)=$PIECE(^ACRDOC(ACRDOCDA,5),U,5)
+21 SET DIE="^AUTTVNDR("
+22 SET DR="[ACR VENDOR REMIT TO ADDRESS]"
+23 DO DDS^ACRFDIC
+24 IF $DATA(ACRSCREN)
KILL ACRSCREN
DO DIE^ACRFDIC
+25 ;ACR*2.1*22.14
QUIT
+26 ;I '$P($G(^ACRAU(DUZ,1)),U,15) D Q ;ACR*2.1*22.14
+27 ; Get ARMS User Vendor Edit Authority;ACR*2.1*22.14
SET ACRVAUTH=$$EDITAUTH^ACRFVLK(DUZ)
+28 ;ACR*2.1*22.14
IF ",A,F,"'[(","_ACRVAUTH_",")
DO MSG^ACRFVLK
QUIT
+29 ;.W @IOF,!!,"You do not have authority to edit data other than the REMIT TO ADDRESS." ;ACR*2.1*22.14
+30 ;.W !,"If other vendor data needs to be added or changed, contact the ARMS Manager" ;ACR*2.1*22.14
+31 ;.W !,"to find someone who can add or change the vendor data before processing payment." ;ACR*2.1*22.14
+32 ;.D PAUSE^ACRFWARN ;ACR*2.1*22.14
+33 ;I $P($G(^ACRAU(DUZ,1)),U,15) D Q ;ACR*2.1*22.14
+34 WRITE @IOF,!!,"WARNING: Vendor data is shared by many different computer systems."
+35 WRITE !,"Be ABSOLUTLEY CERTAIN the vendor data you are adding or changing is correct"
+36 WRITE !,"before making any changes."
+37 DO PAUSE^ACRFWARN
+38 ; D ADD^AUTTVLK ; ACR*2.1*20.14
+39 ; ACR*2.1*20.14
DO ADD^ACRFVLK
+40 QUIT
VCHNG ;NEW SUBROUTINE ;ACR*2.1*22.14
+1 KILL ACRQUIT
+2 SET DIR(0)="YO"
+3 SET DIR("B")="YES"
+4 SET DIR("A")="Do you want to change the Payee to a different Vendor?"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y
DO VCHANGE^ACRFRR1
QUIT
+8 SET ACRQUIT=1
+9 QUIT
+10 ;
IDATE SET DA=ACRDOCDA
+1 SET DIE="^ACRDOC("
+2 SET DR="113210T;103200T;103200.2T;103200.1T;2001"
+3 WRITE !
+4 DO DIE^ACRFDIC
+5 SET ACRDOCPO=^ACRDOC(ACRDOCDA,"PO")
+6 SET ACRIVNO=$PIECE(ACRDOCPO,U,16)
+7 SET DA=ACRDOCDA
+8 SET DIE="^ACRDOC("
+9 NEW X
+10 SET DR=";103811////"
+11 SET X=0
+12 FOR
SET X=$ORDER(^ACRDOC(ACRDOCDA,20,X))
IF 'X
QUIT
IF $PIECE(^ACRDOC(ACRDOCDA,20,X,0),U)'["NOT STATED"
IF $PIECE(^(0),U)]""
SET DR=DR_$PIECE(^ACRDOC(ACRDOCDA,20,X,0),U)_","
IF $LENGTH(DR)>60
QUIT
+13 SET DR="103810////"_ACRIVNO_DR
+14 DO DIE^ACRFDIC
+15 QUIT
REOPEN ;EP;TO RE-OPEN A RECEIVING REPORT WHICH HAS BEEN FINANLIZED
+1 WRITE @IOF
+2 WRITE !?15,"UTILITY TO RE-OPEN FINALIZED ",$SELECT('$DATA(ACRIV)#2:"RECEIVING REPORTS",1:"PAYMENT")
+3 FOR
DO RE
IF $DATA(ACRQUIT)
QUIT
+4 KILL ACRQUIT
+5 QUIT
RE ;SELECT RECEIVING REPORT DOCUMENT TO RE-OPEN
+1 SET DIC="^ACRDOC("
+2 SET DIC(0)="AEMQ"
+3 SET DIC("A")="Document NO.: "
+4 SET DIC("S")="S ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACRAPV,U,6)=1&$D(^ACRRR(""AC"",+Y))!($P(ACRAPV,U,9)=1)"
+5 IF $DATA(ACRIV)#2
SET DIC("S")="S ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACRAPV,U,9)=1"
+6 WRITE !!
+7 DO DIC^ACRFDIC
+8 KILL ACRAPV
+9 IF +Y<1
SET ACRQUIT=""
QUIT
+10 IF '$DATA(^ACROBL(+Y,0))!'$DATA(^ACROBL(+Y,"APV"))
QUIT
+11 SET ACRDOCDA=+Y
+12 SET ACRDOC=$SELECT($PIECE(^ACRDOC(+Y,0),U,2)]"":$PIECE(^(0),U,2),1:$PIECE(^(0),U))
+13 IF '$DATA(ACRIV)#2
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,9)=1
NEW ACRIV
SET ACRIV=""
+14 SET DIR(0)="YO"
+15 SET DIR("A",1)="Are you certain you want to RE-OPEN Document NO. "_ACRDOC
+16 SET DIR("A")="for further "_$SELECT('$DATA(ACRIV)#2:"receiving action",1:"invoice audit")
+17 SET DIR("B")="NO"
+18 WRITE !
+19 DO DIR^ACRFDIC
+20 IF Y'=1
QUIT
+21 KILL ACRDR
+22 IF $DATA(ACRIV)#2
Begin DoDot:1
+23 SET DIR(0)="YO"
+24 SET DIR("A",1)="Do you also want to RE-OPEN Document NO. "_ACRDOC
+25 SET DIR("A")="for further receiving action"
+26 SET DIR("B")="NO"
+27 WRITE !
+28 DO DIR^ACRFDIC
+29 IF Y=1
SET ACRDR="909////2;"
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+30 SET DA=ACRDOCDA
+31 SET DIE="^ACROBL("
+32 SET DR=$GET(ACRDR)_$SELECT('$DATA(ACRIV)#2:"909////2",1:"912////2")
+33 DO DIE^ACRFDIC
+34 SET ACR=0
+35 FOR
SET ACR=$ORDER(^ACRSS("J",ACRDOCDA,ACR))
IF 'ACR
QUIT
IF $DATA(^ACRSS(ACR,0))
IF $PIECE(^(0),U,2)'=ACRDOCDA
SET ACRDOC($PIECE(^(0),U,2))=""
+36 SET ACRDOC(ACRDOCDA)=""
+37 SET ACR=0
+38 IF '$DATA(ACRIV)#2!$DATA(ACRDR)
FOR
SET ACR=$ORDER(ACRDOC(ACR))
IF 'ACR
QUIT
IF $DATA(^ACRRR("C",ACR))
Begin DoDot:1
+39 SET ACRRRDA=0
+40 FOR
SET ACRRRDA=$ORDER(^ACRRR("C",ACR,ACRRRDA))
IF 'ACRRRDA
QUIT
Begin DoDot:2
+41 SET ACRRR0=$GET(^ACRRR(ACRRRDA,0))
+42 IF $PIECE(ACRRR0,U,8)=1
IF $PIECE(ACRRR0,U,11)'=1
Begin DoDot:3
+43 SET DA=ACRRRDA
+44 SET DIE="^ACRRR("
+45 SET DR=".08////2"
+46 DO DIE^ACRFDIC
End DoDot:3
End DoDot:2
End DoDot:1
+47 WRITE !!,ACRDOC," is now available for additional ",$SELECT('$DATA(ACRIV)#2:"receiving",1:"payment")," action."
+48 DO PAUSE^ACRFWARN
+49 QUIT
