| 1 | PRCFDCIP ;WISC@ALTOONA/CLH-VARIOUS PRINT ROUTINES FOR CI ; 1/23/97 1:55 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | FIS ;PRINT OF INVOICES DUE IN FISCAL ON "T" TO "T+1"
|
|---|
| 5 | S DIC="^PRCF(421.5,",BY="[PRCF CI OUT SORT]",TO="TODAY",FR="1901"
|
|---|
| 6 | N PRCFDHIT S DIOBEG="S PRCFDHIT=0",DHIT="S PRCFDHIT=PRCFDHIT+1"
|
|---|
| 7 | S DIOEND="I 'PRCFDHIT W ""CERTIFIED INVOICE DUE IN FISCAL LIST"",!!,""NO INVOICES DUE IN FISCAL FOUND"",!!,""[End of Report]"""
|
|---|
| 8 | S FLDS="[PRCFD DUE IN FISCAL PRINT]" D EN1^DIP K DIC,BY,TO,FR,FLDS Q
|
|---|
| 9 | QUE ;C.I.'S DUE FOR PAYMENT
|
|---|
| 10 | I $D(ZTQUEUED) G PD
|
|---|
| 11 | S ZTRTN="PD^PRCFDCIP",ZTDESC="PRINT CERT. INV. DUE FOR PAYMENT" D ^PRCFQ
|
|---|
| 12 | K DIC,TO,FR,BY,FLDS Q
|
|---|
| 13 | PD ;QUE'D ENTRY POINT
|
|---|
| 14 | D:$D(ZTQUEUED) KILL^%ZTLOAD
|
|---|
| 15 | I '$D(PRIOP) S PRIOP=$S($D(ION):ION,1:IO)
|
|---|
| 16 | S IOP=PRIOP,DIC="^PRCF(421.5,",BY="[PRCF CI DISCOUNT DUE SORT]"
|
|---|
| 17 | S TO="TODAY+15",FR="T-180",FLDS="[PRCF CI DISCOUNT DUE PRINT]"
|
|---|
| 18 | N PRCFDHIT S DIOBEG="S PRCFDHIT=0",DHIT="S PRCFDHIT=PRCFDHIT+1"
|
|---|
| 19 | S DIOEND="I 'PRCFDHIT W ""CERTIFIED INVOICE DISCOUNT DUE LIST"",!!,""NO DISCOUNT DUE INVOICES FOUND"",!!,""[End of Report]"""
|
|---|
| 20 | D EN1^DIP
|
|---|
| 21 | S IOP=PRIOP,DIC="^PRCF(421.5,",BY="[PRCF CI NET DUE DATE SORT]"
|
|---|
| 22 | S TO="TODAY+15",FR="T-180",FLDS="[PRCF CI NET DUE DATE PRINT]"
|
|---|
| 23 | N PRCFDHIT S DIOBEG="S PRCFDHIT=0",DHIT="S PRCFDHIT=PRCFDHIT+1"
|
|---|
| 24 | S DIOEND="I 'PRCFDHIT W ""CERTIFIED INVOICE NET DUE LIST"",!!,""NO NET DUE INVOICES FOUND"",!!,""[End of Report]"""
|
|---|
| 25 | D EN1^DIP
|
|---|
| 26 | K DIC,TO,FR,BY,FLDS,PRIOP Q
|
|---|
| 27 | ENTER ; Set Payment Dates for Single Entry at same time as PPay terms
|
|---|
| 28 | N DISC,INVDT,J,NDISC,NET,NODE0,NODE6,PRCFINV,SVCDT,X,X1,X2
|
|---|
| 29 | Q:'$D(^PRCF(421.5,PRCF("CIDA"),6)) ; Quit if no prompt pay terms
|
|---|
| 30 | S NODE0=$G(^PRCF(421.5,PRCF("CIDA"),0))
|
|---|
| 31 | S INVDT=$P(NODE0,U,5),SVCDT=$P(NODE0,U,21)
|
|---|
| 32 | S J=0,(NET,DISC)=-1 F S J=$O(^PRCF(421.5,PRCF("CIDA"),6,J)) Q:+J'>0 D
|
|---|
| 33 | . S NODE6=$G(^PRCF(421.5,PRCF("CIDA"),6,J,0)) Q:NODE6=""
|
|---|
| 34 | . I $P(NODE6,U,3)="NET",$P(NODE6,U,5)>0 S NET=$P(NODE6,U,5)
|
|---|
| 35 | . I "NET"'[$P(NODE6,U,3),$P(NODE6,U,5)>0 D
|
|---|
| 36 | . . S NDISC=$P(NODE6,U,5) I DISC=-1 S DISC=NDISC
|
|---|
| 37 | . . I NDISC<DISC S DISC=NDISC
|
|---|
| 38 | . . Q
|
|---|
| 39 | . Q
|
|---|
| 40 | I $G(DISC)>0 S X1=INVDT,X2=DISC D C^%DTC S $P(^PRCF(421.5,PRCF("CIDA"),2),U,6)=X
|
|---|
| 41 | I $G(NET)]"" D
|
|---|
| 42 | . I INVDT>SVCDT S X1=INVDT
|
|---|
| 43 | . I INVDT'>SVCDT S X1=SVCDT
|
|---|
| 44 | . S X2=NET D C^%DTC S $P(^PRCF(421.5,PRCF("CIDA"),2),U,7)=X
|
|---|
| 45 | . Q
|
|---|
| 46 | Q
|
|---|
