| 1 | PRCFDBL2 ;WISC@ALTOONA/CLH/LEM-BULLETIN GENERATOR FOR NEXT DAY DUE DATE ;7/19/95 14:30
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;FIND INVOICES DUE IN FISCAL UP THROUGH TOMORROW
|
|---|
| 5 | OUT K PRCFDATE,PRCFDCPN,PRCFDA1,PRCFDA11,PRC("SITE"),PRCFDA,PRCFDL,PRCFDT,PRCFDFCP,PRCFLN,PRCFPOP,^TMP($J),CNT,XMSUB,XMTEXT,XMY
|
|---|
| 6 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 7 | Q
|
|---|
| 8 | EN I $D(ZTSK) G DQ
|
|---|
| 9 | S %A="This Option Generates Messages to those services having outstanding",%A(.5)="and late certified invoices.",%A(1)="OK to Continue",%B="",%=1 D ^PRCFYN Q:%'=1
|
|---|
| 10 | S PRCF("X")="AS" D ^PRCFSITE Q:'%
|
|---|
| 11 | S ZTIO="",ZTDESC="Certified Invoice Bulletin Generator"
|
|---|
| 12 | S ZTSAVE("PRC*")="",ZTRTN="DQ^PRCFDBL2" D ^PRCFQ
|
|---|
| 13 | Q
|
|---|
| 14 | DQ ;I $D(ZTQUEUED) D KILL^%ZTLOAD
|
|---|
| 15 | K ^TMP($J) S U="^",X="T+1" D ^%DT S PRCFDT=Y D DD^%DT S PRCFDATE=Y
|
|---|
| 16 | ; Quit if no invoices due:
|
|---|
| 17 | G OUT:$O(^PRCF(421.5,"AC",0))>PRCFDT,OUT:$O(^PRCF(421.5,"AC",0))=""
|
|---|
| 18 | S PRCFDL=PRCFDT,PRCFDT=0 F S PRCFDT=$O(^PRCF(421.5,"AC",PRCFDT)) Q:PRCFDT>PRCFDL!(PRCFDT="") S PRCFDA=0 F S PRCFDA=$O(^PRCF(421.5,"AC",PRCFDT,PRCFDA)) Q:'PRCFDA D SET
|
|---|
| 19 | S PRCFDFCP=0 F S PRCFDFCP=$O(^TMP($J,"I",PRCFDFCP)) Q:'PRCFDFCP D MSG
|
|---|
| 20 | G OUT
|
|---|
| 21 | SET ;BUILD TMP WITH FCP'S
|
|---|
| 22 | S PRC("SITE")=+$P(^PRCF(421.5,PRCFDA,2),U,3)
|
|---|
| 23 | S PRCFPOP=$P(^PRCF(421.5,PRCFDA,0),U,7) Q:'PRCFPOP ; No P.O. pointer
|
|---|
| 24 | S PRCFDCPN=$P($G(^PRC(442,PRCFPOP,0)),U,3)
|
|---|
| 25 | S PRCFDFCP=PRCFDCPN_"-"_PRC("SITE")
|
|---|
| 26 | S ^TMP($J,"I",PRCFDFCP,PRCFDT,PRCFDA)=""
|
|---|
| 27 | Q
|
|---|
| 28 | MSG ;BUILD FIRST PART OF MESSAGE FOR AN FCP
|
|---|
| 29 | S ^TMP($J,"MSG",1,0)="",^TMP($J,"MSG",2,0)="The following invoice(s) are DUE in Fiscal on or before "_PRCFDATE,^TMP($J,"MSG",3,0)="for Control Point "_PRCFDFCP_":",^TMP($J,"MSG",4,0)=""
|
|---|
| 30 | ;LOOP THROUGH ^TMP FOR ALL DUE INVOICES BUILD 2ND PART OF MSG
|
|---|
| 31 | S CNT=4,PRCFDT=0 F S PRCFDT=$O(^TMP($J,"I",PRCFDFCP,PRCFDT)) Q:'PRCFDT D LINE
|
|---|
| 32 | ;DETERMINE MESSAGE RECIEPENTS AND SEND MESSAGE
|
|---|
| 33 | K XMY F I=0:0 S I=$O(^PRC(420,PRC("SITE"),1,+PRCFDFCP,1,I)) Q:'I I $D(^(I,0)) S X=^(0) I 12[$P(X,"^",2),$P(X,"^")]"" S XMY(+X)=""
|
|---|
| 34 | S XMDUZ=$S(+$G(PRC("PER")):+PRC("PER"),$D(DUZ):DUZ,1:.5)
|
|---|
| 35 | S XMY(XMDUZ)=""
|
|---|
| 36 | S XMSUB="CERTIFIED INVOICES DUE IN FISCAL",XMTEXT="^TMP($J,""MSG"","
|
|---|
| 37 | S ^TMP($J,"MSG",CNT+1,0)=""
|
|---|
| 38 | S ^TMP($J,"MSG",CNT+2,0)="Please take action and return to Fiscal."
|
|---|
| 39 | D ^XMD
|
|---|
| 40 | S PRCFDT=0 F S PRCFDT=$O(^TMP($J,"I",PRCFDFCP,PRCFDT)) Q:'PRCFDT S PRCFDA11=0 F S PRCFDA11=$O(^TMP($J,"I",PRCFDFCP,PRCFDT,PRCFDA11)) Q:'PRCFDA11 S $P(^PRCF(421.5,PRCFDA11,2),"^",14,16)="1^"_DT_"^"_XMZ
|
|---|
| 41 | K ^TMP($J,"MSG"),XMY
|
|---|
| 42 | Q
|
|---|
| 43 | LINE S PRCFDA11=0 F S PRCFDA11=$O(^TMP($J,"I",PRCFDFCP,PRCFDT,PRCFDA11)) Q:'PRCFDA11 D FORM
|
|---|
| 44 | Q
|
|---|
| 45 | FORM S X=^PRCF(421.5,PRCFDA11,0),PRCFLN="Tracking #: "_$P(X,U)
|
|---|
| 46 | S PRCFLN=PRCFLN_", Vendor: "
|
|---|
| 47 | S:$P(X,U,8)]"" PRCFLN=PRCFLN_$P($G(^PRC(440,$P(X,U,8),0)),U)
|
|---|
| 48 | S:$P(X,U,3)]"" PRCFLN=PRCFLN_", Invoice #: "_$P(X,U,3)
|
|---|
| 49 | S PRCFPO=$P($G(^PRCF(421.5,PRCFDA11,1)),U,3)
|
|---|
| 50 | S:PRCFPO]"" PRCFLN=PRCFLN_", PO#: "_PRCFPO
|
|---|
| 51 | S CNT=CNT+1,^TMP($J,"MSG",CNT,0)=PRCFLN
|
|---|
| 52 | Q
|
|---|
