ACRFIVDX ;IHS/OIRM/DSD/THL,AEF - INVOICE DISPLAY; [ 03/01/2005 1:15 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16**;NOV 05, 2001
;;ROUTINE TO CONTROL DISPLAY, SELECTION, ENTRY OF INVOICE NUMBERS
EN Q
DISPLAY ;EP;TO DISPLAY INVOICES FOR A DOCUMENT/RECEIVING REPORT
Q:$G(ACRDOC)=""
I '$D(^ACRINV("G",ACRDOC)) D D A1
.W !!,"NO Invoices currently on file for DOCUMENT NO.: ",ACRDOC
K ^TMP("ACRINV",$J)
N ACR,ACRJ,ACRN
S (ACR,ACRJ)=0
F S ACR=$O(^ACRINV("G",ACRDOC,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)
DISP ;EP;TO DISPLAY INVOICE INVO
D DH
S ACRJ=0
F S ACRJ=$O(^TMP("ACRINV",$J,ACRJ)) Q:'ACRJ!$D(ACRQUIT) D
.N X,Y
.S X=^TMP("ACRINV",$J,ACRJ)
.S Y=$P(X,U,3)
.X ^DD("DD")
.I ACRMAX>20 D
..W:ACRJ#2 !,ACRJ,?5,$P(X,U,2),?27,Y
..W:ACRJ#2=0 ?40,ACRJ,?45,$P(X,U,2),?67,Y
..I ACRJ#2=0,IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D DH
.I ACRMAX<21 D
..W !?5,ACRJ,?10,$P(X,U,2),?32,Y
..I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D DH
K ACRQUIT,ACROUT
Q
DH W @IOF
DH1 W !?10,"INVOICES FOR DOCUMENT NO.: ",ACRDOC
I ACRMAX>20 D
.W !!,"NO.",?5,"INVOICE NUMBER",?27,"DATE REC'D",?40,"NO.",?45,"INVOICE NUMBER",?67,"DATE REC'D"
.W !,"---",?5,"--------------------",?27,"-----------",?40,"---",?45,"--------------------",?67,"-----------"
I ACRMAX<21 D
.W !!?5,"NO.",?10,"INVOICE NUMBER",?32,"DATE RECEIVED"
.W !?5,"---",?10,"--------------------",?32,"-------------"
Q
EDIT ;EP;TO ADD OR EDIT INVOICE NUMBERS
Q:'$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")="PAID FOR/ACH ADDENDUM for this payment: " ;ACR*2.1*16.06 IM15505
S DIR("A",1)="Select the INVOICE to be included in the" ;ACR*2.1*16.06 IM15505
S DIR("A")="PAID FOR/ACH ADDENDUM field for this payment: " ;ACR*2.1*16.06 IM15505
W !
D DIR^ACRFDIC
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
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,ACRMAX
Q
EDIT1 D DISPLAY
K ACRQUIT
I '$D(^ACRINV("G",ACRDOC)) 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
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"
I $G(ACRREF)=618,$G(ACRINVX)]"" S DIR("B")=ACRINVX K ACRINVX
W !
D DIR^ACRFDIC
I $D(ACROUT)!(X["^")!(X="")!(Y="")!($E(Y)=" ") D G A1 ;ACR*2.1*3.29
.W !!,"Invoice number is required."
.K ACROUT,ACRQUIT
S ACRINV=Y
I $G(ACRREF)'=618,$D(^ACRINV("B",Y)) D DUP I $D(ACRQUIT) K ACRQUIT Q
S DIC="^ACRINV("
S DIC(0)="L"
S DIC("DR")=".06////"_ACRVDA_";.07////"_ACRDOC_";.08////"_$G(ACRFYDA)_";.09////"_$G(ACRBATDA)_";.1////"_$G(ACRSEQDA)
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 X=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) ;ACR*2.1*16.06 IM15505
S:$G(ACRREF)=618 ACRINVX=$P(X,U)
S:$G(ACRDOCDA) DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="103200.1////"_$P(X,U,4)_";103200.2////"_$P(X,U,3)
S ACRIVDAT=$P(X,U,4)
D DIE^ACRFDIC:$G(ACRDOCDA)
K DIE,DA,DR
Q
ACRFIVDX ;IHS/OIRM/DSD/THL,AEF - INVOICE DISPLAY; [ 03/01/2005 1:15 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,16**;NOV 05, 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(ACRDOC)=""
QUIT
+2 IF '$DATA(^ACRINV("G",ACRDOC))
Begin DoDot:1
+3 WRITE !!,"NO Invoices currently on file for DOCUMENT NO.: ",ACRDOC
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("G",ACRDOC,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
DISP ;EP;TO DISPLAY INVOICE INVO
+1 DO DH
+2 SET ACRJ=0
+3 FOR
SET ACRJ=$ORDER(^TMP("ACRINV",$JOB,ACRJ))
IF 'ACRJ!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 NEW X,Y
+5 SET X=^TMP("ACRINV",$JOB,ACRJ)
+6 SET Y=$PIECE(X,U,3)
+7 XECUTE ^DD("DD")
+8 IF ACRMAX>20
Begin DoDot:2
+9 IF ACRJ#2
WRITE !,ACRJ,?5,$PIECE(X,U,2),?27,Y
+10 IF ACRJ#2=0
WRITE ?40,ACRJ,?45,$PIECE(X,U,2),?67,Y
+11 IF ACRJ#2=0
IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO DH
End DoDot:2
+12 IF ACRMAX<21
Begin DoDot:2
+13 WRITE !?5,ACRJ,?10,$PIECE(X,U,2),?32,Y
+14 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO DH
End DoDot:2
End DoDot:1
+15 KILL ACRQUIT,ACROUT
+16 QUIT
DH WRITE @IOF
DH1 WRITE !?10,"INVOICES FOR DOCUMENT NO.: ",ACRDOC
+1 IF ACRMAX>20
Begin DoDot:1
+2 WRITE !!,"NO.",?5,"INVOICE NUMBER",?27,"DATE REC'D",?40,"NO.",?45,"INVOICE NUMBER",?67,"DATE REC'D"
+3 WRITE !,"---",?5,"--------------------",?27,"-----------",?40,"---",?45,"--------------------",?67,"-----------"
End DoDot:1
+4 IF ACRMAX<21
Begin DoDot:1
+5 WRITE !!?5,"NO.",?10,"INVOICE NUMBER",?32,"DATE RECEIVED"
+6 WRITE !?5,"---",?10,"--------------------",?32,"-------------"
End DoDot:1
+7 QUIT
EDIT ;EP;TO ADD OR EDIT INVOICE NUMBERS
+1 IF '$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 ;S DIR("A")="PAID FOR/ACH ADDENDUM for this payment: " ;ACR*2.1*16.06 IM15505
+5 ;ACR*2.1*16.06 IM15505
SET DIR("A",1)="Select the INVOICE to be included in the"
+6 ;ACR*2.1*16.06 IM15505
SET DIR("A")="PAID FOR/ACH ADDENDUM field for this payment: "
+7 WRITE !
+8 DO DIR^ACRFDIC
+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 Y<1!'$DATA(^TMP("ACRINV",$JOB,+Y))
Begin DoDot:1
+9 WRITE !!,"You must indicate which is the PRIMARY Invoice so the system"
+10 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,ACRMAX
+1 QUIT
EDIT1 DO DISPLAY
+1 KILL ACRQUIT
+2 IF '$DATA(^ACRINV("G",ACRDOC))
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 +Y<1!$DATA(ACRQUIT)!'$GET(^TMP("ACRINV",$JOB,+Y))
KILL ACRQUIT
QUIT
+7 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 IF $GET(ACRREF)=618
IF $GET(ACRINVX)]""
SET DIR("B")=ACRINVX
KILL ACRINVX
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 ;ACR*2.1*3.29
IF $DATA(ACROUT)!(X["^")!(X="")!(Y="")!($EXTRACT(Y)=" ")
Begin DoDot:1
+7 WRITE !!,"Invoice number is required."
+8 KILL ACROUT,ACRQUIT
End DoDot:1
GOTO A1
+9 SET ACRINV=Y
+10 IF $GET(ACRREF)'=618
IF $DATA(^ACRINV("B",Y))
DO DUP
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+11 SET DIC="^ACRINV("
+12 SET DIC(0)="L"
+13 SET DIC("DR")=".06////"_ACRVDA_";.07////"_ACRDOC_";.08////"_$GET(ACRFYDA)_";.09////"_$GET(ACRBATDA)_";.1////"_$GET(ACRSEQDA)
+14 DO FILE^ACRFDIC
+15 SET (ACRINVDA,DA)=+Y
+16 DO E11
+17 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 X=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 ;ACR*2.1*16.06 IM15505
SET ACRINV=$PIECE(X,U)
+5 IF $GET(ACRREF)=618
SET ACRINVX=$PIECE(X,U)
+6 IF $GET(ACRDOCDA)
SET DA=ACRDOCDA
+7 SET DIE="^ACRDOC("
+8 SET DR="103200.1////"_$PIECE(X,U,4)_";103200.2////"_$PIECE(X,U,3)
+9 SET ACRIVDAT=$PIECE(X,U,4)
+10 IF $GET(ACRDOCDA)
DO DIE^ACRFDIC
+11 KILL DIE,DA,DR
+12 QUIT
