ACRFIVDX.m

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