PRCFDBL2 ;WISC@ALTOONA/CLH/LEM-BULLETIN GENERATOR FOR NEXT DAY DUE DATE ;7/19/95 14:30
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;FIND INVOICES DUE IN FISCAL UP THROUGH TOMORROW
OUT K PRCFDATE,PRCFDCPN,PRCFDA1,PRCFDA11,PRC("SITE"),PRCFDA,PRCFDL,PRCFDT,PRCFDFCP,PRCFLN,PRCFPOP,^TMP($J),CNT,XMSUB,XMTEXT,XMY
S:$D(ZTQUEUED) ZTREQ="@"
Q
EN I $D(ZTSK) G DQ
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
S PRCF("X")="AS" D ^PRCFSITE Q:'%
S ZTIO="",ZTDESC="Certified Invoice Bulletin Generator"
S ZTSAVE("PRC*")="",ZTRTN="DQ^PRCFDBL2" D ^PRCFQ
Q
DQ ;I $D(ZTQUEUED) D KILL^%ZTLOAD
K ^TMP($J) S U="^",X="T+1" D ^%DT S PRCFDT=Y D DD^%DT S PRCFDATE=Y
; Quit if no invoices due:
G OUT:$O(^PRCF(421.5,"AC",0))>PRCFDT,OUT:$O(^PRCF(421.5,"AC",0))=""
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
S PRCFDFCP=0 F S PRCFDFCP=$O(^TMP($J,"I",PRCFDFCP)) Q:'PRCFDFCP D MSG
G OUT
SET ;BUILD TMP WITH FCP'S
S PRC("SITE")=+$P(^PRCF(421.5,PRCFDA,2),U,3)
S PRCFPOP=$P(^PRCF(421.5,PRCFDA,0),U,7) Q:'PRCFPOP ; No P.O. pointer
S PRCFDCPN=$P($G(^PRC(442,PRCFPOP,0)),U,3)
S PRCFDFCP=PRCFDCPN_"-"_PRC("SITE")
S ^TMP($J,"I",PRCFDFCP,PRCFDT,PRCFDA)=""
Q
MSG ;BUILD FIRST PART OF MESSAGE FOR AN FCP
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)=""
;LOOP THROUGH ^TMP FOR ALL DUE INVOICES BUILD 2ND PART OF MSG
S CNT=4,PRCFDT=0 F S PRCFDT=$O(^TMP($J,"I",PRCFDFCP,PRCFDT)) Q:'PRCFDT D LINE
;DETERMINE MESSAGE RECIEPENTS AND SEND MESSAGE
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)=""
S XMDUZ=$S(+$G(PRC("PER")):+PRC("PER"),$D(DUZ):DUZ,1:.5)
S XMY(XMDUZ)=""
S XMSUB="CERTIFIED INVOICES DUE IN FISCAL",XMTEXT="^TMP($J,""MSG"","
S ^TMP($J,"MSG",CNT+1,0)=""
S ^TMP($J,"MSG",CNT+2,0)="Please take action and return to Fiscal."
D ^XMD
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
K ^TMP($J,"MSG"),XMY
Q
LINE S PRCFDA11=0 F S PRCFDA11=$O(^TMP($J,"I",PRCFDFCP,PRCFDT,PRCFDA11)) Q:'PRCFDA11 D FORM
Q
FORM S X=^PRCF(421.5,PRCFDA11,0),PRCFLN="Tracking #: "_$P(X,U)
S PRCFLN=PRCFLN_", Vendor: "
S:$P(X,U,8)]"" PRCFLN=PRCFLN_$P($G(^PRC(440,$P(X,U,8),0)),U)
S:$P(X,U,3)]"" PRCFLN=PRCFLN_", Invoice #: "_$P(X,U,3)
S PRCFPO=$P($G(^PRCF(421.5,PRCFDA11,1)),U,3)
S:PRCFPO]"" PRCFLN=PRCFLN_", PO#: "_PRCFPO
S CNT=CNT+1,^TMP($J,"MSG",CNT,0)=PRCFLN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDBL2 2970 printed Sep 23, 2025@19:38:56 Page 2
PRCFDBL2 ;WISC@ALTOONA/CLH/LEM-BULLETIN GENERATOR FOR NEXT DAY DUE DATE ;7/19/95 14:30
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;FIND INVOICES DUE IN FISCAL UP THROUGH TOMORROW
OUT KILL PRCFDATE,PRCFDCPN,PRCFDA1,PRCFDA11,PRC("SITE"),PRCFDA,PRCFDL,PRCFDT,PRCFDFCP,PRCFLN,PRCFPOP,^TMP($JOB),CNT,XMSUB,XMTEXT,XMY
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
EN IF $DATA(ZTSK)
GOTO DQ
+1 SET %A="This Option Generates Messages to those services having outstanding"
SET %A(.5)="and late certified invoices."
SET %A(1)="OK to Continue"
SET %B=""
SET %=1
DO ^PRCFYN
if %'=1
QUIT
+2 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+3 SET ZTIO=""
SET ZTDESC="Certified Invoice Bulletin Generator"
+4 SET ZTSAVE("PRC*")=""
SET ZTRTN="DQ^PRCFDBL2"
DO ^PRCFQ
+5 QUIT
DQ ;I $D(ZTQUEUED) D KILL^%ZTLOAD
+1 KILL ^TMP($JOB)
SET U="^"
SET X="T+1"
DO ^%DT
SET PRCFDT=Y
DO DD^%DT
SET PRCFDATE=Y
+2 ; Quit if no invoices due:
+3 if $ORDER(^PRCF(421.5,"AC",0))>PRCFDT
GOTO OUT
if $ORDER(^PRCF(421.5,"AC",0))=""
GOTO OUT
+4 SET PRCFDL=PRCFDT
SET PRCFDT=0
FOR
SET PRCFDT=$ORDER(^PRCF(421.5,"AC",PRCFDT))
if PRCFDT>PRCFDL!(PRCFDT="")
QUIT
SET PRCFDA=0
FOR
SET PRCFDA=$ORDER(^PRCF(421.5,"AC",PRCFDT,PRCFDA))
if 'PRCFDA
QUIT
DO SET
+5 SET PRCFDFCP=0
FOR
SET PRCFDFCP=$ORDER(^TMP($JOB,"I",PRCFDFCP))
if 'PRCFDFCP
QUIT
DO MSG
+6 GOTO OUT
SET ;BUILD TMP WITH FCP'S
+1 SET PRC("SITE")=+$PIECE(^PRCF(421.5,PRCFDA,2),U,3)
+2 ; No P.O. pointer
SET PRCFPOP=$PIECE(^PRCF(421.5,PRCFDA,0),U,7)
if 'PRCFPOP
QUIT
+3 SET PRCFDCPN=$PIECE($GET(^PRC(442,PRCFPOP,0)),U,3)
+4 SET PRCFDFCP=PRCFDCPN_"-"_PRC("SITE")
+5 SET ^TMP($JOB,"I",PRCFDFCP,PRCFDT,PRCFDA)=""
+6 QUIT
MSG ;BUILD FIRST PART OF MESSAGE FOR AN FCP
+1 SET ^TMP($JOB,"MSG",1,0)=""
SET ^TMP($JOB,"MSG",2,0)="The following invoice(s) are DUE in Fiscal on or before "_PRCFDATE
SET ^TMP($JOB,"MSG",3,0)="for Control Point "_PRCFDFCP_":"
SET ^TMP($JOB,"MSG",4,0)=""
+2 ;LOOP THROUGH ^TMP FOR ALL DUE INVOICES BUILD 2ND PART OF MSG
+3 SET CNT=4
SET PRCFDT=0
FOR
SET PRCFDT=$ORDER(^TMP($JOB,"I",PRCFDFCP,PRCFDT))
if 'PRCFDT
QUIT
DO LINE
+4 ;DETERMINE MESSAGE RECIEPENTS AND SEND MESSAGE
+5 KILL XMY
FOR I=0:0
SET I=$ORDER(^PRC(420,PRC("SITE"),1,+PRCFDFCP,1,I))
if 'I
QUIT
IF $DATA(^(I,0))
SET X=^(0)
IF 12[$PIECE(X,"^",2)
IF $PIECE(X,"^")]""
SET XMY(+X)=""
+6 SET XMDUZ=$SELECT(+$GET(PRC("PER")):+PRC("PER"),$DATA(DUZ):DUZ,1:.5)
+7 SET XMY(XMDUZ)=""
+8 SET XMSUB="CERTIFIED INVOICES DUE IN FISCAL"
SET XMTEXT="^TMP($J,""MSG"","
+9 SET ^TMP($JOB,"MSG",CNT+1,0)=""
+10 SET ^TMP($JOB,"MSG",CNT+2,0)="Please take action and return to Fiscal."
+11 DO ^XMD
+12 SET PRCFDT=0
FOR
SET PRCFDT=$ORDER(^TMP($JOB,"I",PRCFDFCP,PRCFDT))
if 'PRCFDT
QUIT
SET PRCFDA11=0
FOR
SET PRCFDA11=$ORDER(^TMP($JOB,"I",PRCFDFCP,PRCFDT,PRCFDA11))
if 'PRCFDA11
QUIT
SET $PIECE(^PRCF(421.5,PRCFDA11,2),"^",14,16)="1^"_DT_"^"_XMZ
+13 KILL ^TMP($JOB,"MSG"),XMY
+14 QUIT
LINE SET PRCFDA11=0
FOR
SET PRCFDA11=$ORDER(^TMP($JOB,"I",PRCFDFCP,PRCFDT,PRCFDA11))
if 'PRCFDA11
QUIT
DO FORM
+1 QUIT
FORM SET X=^PRCF(421.5,PRCFDA11,0)
SET PRCFLN="Tracking #: "_$PIECE(X,U)
+1 SET PRCFLN=PRCFLN_", Vendor: "
+2 if $PIECE(X,U,8)]""
SET PRCFLN=PRCFLN_$PIECE($GET(^PRC(440,$PIECE(X,U,8),0)),U)
+3 if $PIECE(X,U,3)]""
SET PRCFLN=PRCFLN_", Invoice #: "_$PIECE(X,U,3)
+4 SET PRCFPO=$PIECE($GET(^PRCF(421.5,PRCFDA11,1)),U,3)
+5 if PRCFPO]""
SET PRCFLN=PRCFLN_", PO#: "_PRCFPO
+6 SET CNT=CNT+1
SET ^TMP($JOB,"MSG",CNT,0)=PRCFLN
+7 QUIT
