Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFDCIP

PRCFDCIP.m

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