ACRFIVD.m

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