ACRFIVD ;IHS/OIRM/DSD/THL,AEF - INVOICE DISPLAY; [ 03/24/2005 1:31 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;JUL 31, 2001
;;ROUTINE TO CONTROL DISPLAY, SELECTION, ENTRY OF INVOICE NUMBERS
EN Q
DISPLAY ;EP;TO DISPLAY INVOICES FOR A DOCUMENT/RECEIVING REPORT
Q:'$G(ACRDOCDA)
I '$D(^ACRINV("C",ACRDOCDA)) D D A1
.W !!,"NO Invoices currently on file for DOCUMENT NO.: ",$P(^ACRDOC(ACRDOCDA,0),U,2)," ",$P(^(0),U)
K ^TMP("ACRINV",$J)
N ACR,ACRJ,ACRN
S (ACR,ACRJ)=0
F S ACR=$O(^ACRINV("C",ACRDOCDA,ACR)) Q:'ACR S X=$G(^ACRINV(ACR,0)) I $P(X,U)]"" S ACRJ=ACRJ+1,^TMP("ACRINV",$J,"INV",$P(X,U),ACRJ)=ACR_U_$P(X,U)_U_$P(X,U,4)
S ACRMAX=ACRJ
S ACRN=""
F S ACRN=$O(^TMP("ACRINV",$J,"INV",ACRN)) Q:ACRN="" D
.S ACRJ=0
.F S ACRJ=$O(^TMP("ACRINV",$J,"INV",ACRN,ACRJ)) Q:'ACRJ S ^TMP("ACRINV",$J,ACRJ)=^TMP("ACRINV",$J,"INV",ACRN,ACRJ)
D DISP^ACRFIVDX
Q
EDIT ;EP;TO ADD OR EDIT INVOICE NUMBERS
Q:'$G(ACRDOCDA)!'$D(ACRVDA)
F D EDIT1 Q:$D(ACRQUIT)!$D(ACROUT)
ESET Q:'$G(ACRMAX)!$D(ACROUT)
I ACRMAX=1 S Y=1 D ES1 Q
S DIR(0)="LOA^1:"_$G(ACRMAX)
;S DIR("A",1)="Select ALL INVOICES to include in" ;ACR*2.1*16.06 IM15505
S DIR("A",1)="Select THE INVOICE to be included in the" ;ACR*2.1*15.06 IM15505
S DIR("A")="PAID FOR/ACH ADDENDUM for this payment: "
W !
D DIR^ACRFDIC
Q:$D(ACROUT)!$D(ACRQUIT) ;ACR*2.1*16.06 IM15505
I Y<1 D G ESET
.;W !!,"You must indicate ALL invoices which are included in this" ;ACR*2.1*16.06 IM15505
.;W !,"payment so the system knows which to include in the PAID FOR" ;ACR*2.1*16.06 IM15505
.;W !,"field or ACH ADDENDUM." ;ACR*2.1*16.06 IM15505
.W !!,"You must indicate the invoice that will be included in this" ;ACR*2.1*16.06 IM15505
.W !,"payment so the system knows which to include in the PAID FOR" ;ACR*2.1**16.06 IM15505
.W !,"or ACH ADDENDUM field." ;ACR*2.1**16.06 IM15505
S ACRY=","_ACRY
S X=0
F S X=$O(^TMP("ACRINV",$J,X)) Q:'X I ACRY'[(","_X_",") K ^TMP("ACRINV",$J,X)
ESET1 Q:$D(ACROUT)
I $P(ACRY,",",2),'$P(ACRY,",",3) S Y=$P(ACRY,",",2) I $G(^TMP("ACRINV",$J,+Y)) D ES1 Q
S DIR(0)="NOA^1:"_$G(ACRMAX)
S DIR("A",1)="Select the INVOICE to use for"
S DIR("A")="calculation of payment due dates: "
S DIR("B")=$P(ACRY,",",2)
W !
D DIR^ACRFDIC
Q:$D(ACROUT)!$D(ACRQUIT)
I Y<1!'$D(^TMP("ACRINV",$J,+Y)) D G ESET1
.W !!,"You must indicate which is the PRIMARY Invoice so the system"
.W !,"will know which dates to use to calculate when payment is due."
ES1 S ACRINVDA=+$G(^TMP("ACRINV",$J,Y))
D SETDOC:ACRINVDA
EEXIT K ACRQUIT,ACRINVDA
Q
EDIT1 D DISPLAY
K ACRQUIT
I '$D(^ACRINV("C",ACRDOCDA)) S DIR(0)="SO^2:ADD Invoice"
E S DIR(0)="SO^1:EDIT Invoice;2:ADD Invoice;3:REMOVE Invoice"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
I +Y<1 S ACRQUIT="" Q
I Y=1 D E1 S Y=1
I Y=2 D A1 S Y=2
I Y=3 D D1 S Y=3
Q
E1 ;SELECT AND EDIT INVOICE
Q:'$G(ACRMAX)
S DIR(0)="NO^1:"_ACRMAX
S DIR("A")="Edit which one"
W !
D DIR^ACRFDIC
Q:$D(ACROUT)!$D(ACRQUIT)
I +Y<1!$D(ACRQUIT)!'$G(^TMP("ACRINV",$J,+Y)) K ACRQUIT Q
S (ACRINVDA,DA)=+^TMP("ACRINV",$J,Y)
E11 S DIE="^ACRINV("
S DR="[ACR INVOICE EDIT]"
D DIE^ACRFDIC
Q
A1 ;ADD AN INVOICE
S DIR(0)="FO^1:30"
S DIR("A")="Invoice Number"
W !
D DIR^ACRFDIC
I Y=""!(Y["^") K ACRQUIT Q
S ACRINV=Y
I $D(^ACRINV("B",Y)) D DUP I $D(ACRQUIT) K ACRQUIT Q
S DIC="^ACRINV("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRDOCDA_";.06////"_ACRVDA
D FILE^ACRFDIC
S (ACRINVDA,DA)=+Y
D E11
Q
DUP ;INDICATE DUPLICATE INVOICE
S ACRINVDA=$O(^ACRINV("B",Y,0))
Q:'ACRINVDA
W !!,"INVOICE NUMBER ",Y," is already on file for"
W !,"DOCUMENT NUMBER: ",$P($G(^ACRDOC(+$P($G(^ACRINV(ACRINVDA,0)),U,2),0)),U)
W !,"VENDOR.........: ",$P($G(^AUTTVNDR(+$P($G(^ACRINV(ACRINVDA,0)),U,6),0)),U)
S DIR(0)="YO"
S DIR("A")="Add this as new INVOICE"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
S Y=ACRINV
Q
D1 ;SELECT AND EDIT INVOICE
Q:'$G(ACRMAX)
S DIR(0)="NO^1:"_ACRMAX
S DIR("A")="REMOVE which one"
W !
D DIR^ACRFDIC
I +Y<1!$D(ACRQUIT) K ACRQUIT Q
S DA=+^TMP("ACRINV",$J,Y)
K ^TMP("ACRINV",$J,Y)
S DIK="^ACRINV("
D DIK^ACRFDIC
Q
SETDOC ;SET DATE OF INVOICE AND DATE INVOICE RECEIVED IN FMS DOCUMENT FILE
N X
S X=$G(^ACRINV(+ACRINVDA,0))
Q:X=""
S ACRINV=$P(X,U) ;RESET NUMBER IN CASE OF EDIT ;ACR*2.1*16.06 IM15505
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="103200.1////"_$P(X,U,4)_";103200.2////"_$P(X,U,3)
D DIE^ACRFDIC
Q
ACRFIVD ;IHS/OIRM/DSD/THL,AEF - INVOICE DISPLAY; [ 03/24/2005 1:31 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;JUL 31, 2001
+2 ;;ROUTINE TO CONTROL DISPLAY, SELECTION, ENTRY OF INVOICE NUMBERS
EN QUIT
DISPLAY ;EP;TO DISPLAY INVOICES FOR A DOCUMENT/RECEIVING REPORT
+1 IF '$GET(ACRDOCDA)
QUIT
+2 IF '$DATA(^ACRINV("C",ACRDOCDA))
Begin DoDot:1
+3 WRITE !!,"NO Invoices currently on file for DOCUMENT NO.: ",$PIECE(^ACRDOC(ACRDOCDA,0),U,2)," ",$PIECE(^(0),U)
End DoDot:1
DO A1
+4 KILL ^TMP("ACRINV",$JOB)
+5 NEW ACR,ACRJ,ACRN
+6 SET (ACR,ACRJ)=0
+7 FOR
SET ACR=$ORDER(^ACRINV("C",ACRDOCDA,ACR))
IF 'ACR
QUIT
SET X=$GET(^ACRINV(ACR,0))
IF $PIECE(X,U)]""
SET ACRJ=ACRJ+1
SET ^TMP("ACRINV",$JOB,"INV",$PIECE(X,U),ACRJ)=ACR_U_$PIECE(X,U)_U_$PIECE(X,U,4)
+8 SET ACRMAX=ACRJ
+9 SET ACRN=""
+10 FOR
SET ACRN=$ORDER(^TMP("ACRINV",$JOB,"INV",ACRN))
IF ACRN=""
QUIT
Begin DoDot:1
+11 SET ACRJ=0
+12 FOR
SET ACRJ=$ORDER(^TMP("ACRINV",$JOB,"INV",ACRN,ACRJ))
IF 'ACRJ
QUIT
SET ^TMP("ACRINV",$JOB,ACRJ)=^TMP("ACRINV",$JOB,"INV",ACRN,ACRJ)
End DoDot:1
+13 DO DISP^ACRFIVDX
+14 QUIT
EDIT ;EP;TO ADD OR EDIT INVOICE NUMBERS
+1 IF '$GET(ACRDOCDA)!'$DATA(ACRVDA)
QUIT
+2 FOR
DO EDIT1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
ESET IF '$GET(ACRMAX)!$DATA(ACROUT)
QUIT
+1 IF ACRMAX=1
SET Y=1
DO ES1
QUIT
+2 SET DIR(0)="LOA^1:"_$GET(ACRMAX)
+3 ;S DIR("A",1)="Select ALL INVOICES to include in" ;ACR*2.1*16.06 IM15505
+4 ;ACR*2.1*15.06 IM15505
SET DIR("A",1)="Select THE INVOICE to be included in the"
+5 SET DIR("A")="PAID FOR/ACH ADDENDUM for this payment: "
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 ;ACR*2.1*16.06 IM15505
IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+9 IF Y<1
Begin DoDot:1
+10 ;W !!,"You must indicate ALL invoices which are included in this" ;ACR*2.1*16.06 IM15505
+11 ;W !,"payment so the system knows which to include in the PAID FOR" ;ACR*2.1*16.06 IM15505
+12 ;W !,"field or ACH ADDENDUM." ;ACR*2.1*16.06 IM15505
+13 ;ACR*2.1*16.06 IM15505
WRITE !!,"You must indicate the invoice that will be included in this"
+14 ;ACR*2.1**16.06 IM15505
WRITE !,"payment so the system knows which to include in the PAID FOR"
+15 ;ACR*2.1**16.06 IM15505
WRITE !,"or ACH ADDENDUM field."
End DoDot:1
GOTO ESET
+16 SET ACRY=","_ACRY
+17 SET X=0
+18 FOR
SET X=$ORDER(^TMP("ACRINV",$JOB,X))
IF 'X
QUIT
IF ACRY'[(","_X_",")
KILL ^TMP("ACRINV",$JOB,X)
ESET1 IF $DATA(ACROUT)
QUIT
+1 IF $PIECE(ACRY,",",2)
IF '$PIECE(ACRY,",",3)
SET Y=$PIECE(ACRY,",",2)
IF $GET(^TMP("ACRINV",$JOB,+Y))
DO ES1
QUIT
+2 SET DIR(0)="NOA^1:"_$GET(ACRMAX)
+3 SET DIR("A",1)="Select the INVOICE to use for"
+4 SET DIR("A")="calculation of payment due dates: "
+5 SET DIR("B")=$PIECE(ACRY,",",2)
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+9 IF Y<1!'$DATA(^TMP("ACRINV",$JOB,+Y))
Begin DoDot:1
+10 WRITE !!,"You must indicate which is the PRIMARY Invoice so the system"
+11 WRITE !,"will know which dates to use to calculate when payment is due."
End DoDot:1
GOTO ESET1
ES1 SET ACRINVDA=+$GET(^TMP("ACRINV",$JOB,Y))
+1 IF ACRINVDA
DO SETDOC
EEXIT KILL ACRQUIT,ACRINVDA
+1 QUIT
EDIT1 DO DISPLAY
+1 KILL ACRQUIT
+2 IF '$DATA(^ACRINV("C",ACRDOCDA))
SET DIR(0)="SO^2:ADD Invoice"
+3 IF '$TEST
SET DIR(0)="SO^1:EDIT Invoice;2:ADD Invoice;3:REMOVE Invoice"
+4 SET DIR("A")="Which one"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y<1
SET ACRQUIT=""
QUIT
+8 IF Y=1
DO E1
SET Y=1
+9 IF Y=2
DO A1
SET Y=2
+10 IF Y=3
DO D1
SET Y=3
+11 QUIT
E1 ;SELECT AND EDIT INVOICE
+1 IF '$GET(ACRMAX)
QUIT
+2 SET DIR(0)="NO^1:"_ACRMAX
+3 SET DIR("A")="Edit which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+7 IF +Y<1!$DATA(ACRQUIT)!'$GET(^TMP("ACRINV",$JOB,+Y))
KILL ACRQUIT
QUIT
+8 SET (ACRINVDA,DA)=+^TMP("ACRINV",$JOB,Y)
E11 SET DIE="^ACRINV("
+1 SET DR="[ACR INVOICE EDIT]"
+2 DO DIE^ACRFDIC
+3 QUIT
A1 ;ADD AN INVOICE
+1 SET DIR(0)="FO^1:30"
+2 SET DIR("A")="Invoice Number"
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF Y=""!(Y["^")
KILL ACRQUIT
QUIT
+6 SET ACRINV=Y
+7 IF $DATA(^ACRINV("B",Y))
DO DUP
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+8 SET DIC="^ACRINV("
+9 SET DIC(0)="L"
+10 SET DIC("DR")=".02////"_ACRDOCDA_";.06////"_ACRVDA
+11 DO FILE^ACRFDIC
+12 SET (ACRINVDA,DA)=+Y
+13 DO E11
+14 QUIT
DUP ;INDICATE DUPLICATE INVOICE
+1 SET ACRINVDA=$ORDER(^ACRINV("B",Y,0))
+2 IF 'ACRINVDA
QUIT
+3 WRITE !!,"INVOICE NUMBER ",Y," is already on file for"
+4 WRITE !,"DOCUMENT NUMBER: ",$PIECE($GET(^ACRDOC(+$PIECE($GET(^ACRINV(ACRINVDA,0)),U,2),0)),U)
+5 WRITE !,"VENDOR.........: ",$PIECE($GET(^AUTTVNDR(+$PIECE($GET(^ACRINV(ACRINVDA,0)),U,6),0)),U)
+6 SET DIR(0)="YO"
+7 SET DIR("A")="Add this as new INVOICE"
+8 SET DIR("B")="NO"
+9 WRITE !
+10 DO DIR^ACRFDIC
+11 IF Y'=1
SET ACRQUIT=""
QUIT
+12 SET Y=ACRINV
+13 QUIT
D1 ;SELECT AND EDIT INVOICE
+1 IF '$GET(ACRMAX)
QUIT
+2 SET DIR(0)="NO^1:"_ACRMAX
+3 SET DIR("A")="REMOVE which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF +Y<1!$DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+7 SET DA=+^TMP("ACRINV",$JOB,Y)
+8 KILL ^TMP("ACRINV",$JOB,Y)
+9 SET DIK="^ACRINV("
+10 DO DIK^ACRFDIC
+11 QUIT
SETDOC ;SET DATE OF INVOICE AND DATE INVOICE RECEIVED IN FMS DOCUMENT FILE
+1 NEW X
+2 SET X=$GET(^ACRINV(+ACRINVDA,0))
+3 IF X=""
QUIT
+4 ;RESET NUMBER IN CASE OF EDIT ;ACR*2.1*16.06 IM15505
SET ACRINV=$PIECE(X,U)
+5 SET DA=ACRDOCDA
+6 SET DIE="^ACRDOC("
+7 SET DR="103200.1////"_$PIECE(X,U,4)_";103200.2////"_$PIECE(X,U,3)
+8 DO DIE^ACRFDIC
+9 QUIT
