source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDCIP.m@ 1742

Last change on this file since 1742 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.3 KB
Line 
1PRCFDCIP ;WISC@ALTOONA/CLH-VARIOUS PRINT ROUTINES FOR CI ; 1/23/97 1:55 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FIS ;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
9QUE ;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
13PD ;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
27ENTER ; 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
Note: See TracBrowser for help on using the repository browser.