- 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
