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