PRCFDBL ;WISC/CLH/LEM-BULLETIN GENERATOR FOR CI'S DUE ;7/19/95 14:30
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
N PRC,X,Y,%,DIR,PRCFDT,DATE
S X="T+7" D ^%DT S PRCFDT=Y D DD^%DT S DATE=Y
I '$D(ZTQUEUED) D Q
. S PRCF("X")="AS" D ^PRCFSITE Q:'%
. W ! S DIR(0)="Y",DIR("T")=120,DIR("A")="Okay to continue",DIR("A",1)="This option generates bulletins to those services having",DIR("A",2)="a Certified Invoice due in Fiscal on "_DATE_".",DIR("?")="^D CI^PRCFHLP"
. S DIR("A",3)=" ",DIR("A",4)="This job is scheduled to run on a daily basis",DIR("A",5)="Are you sure you want to run this option manually?" D ^DIR K DIR
. I 'Y Q
. S ZTDTH=$H,ZTIO="",ZTDESC="Certified Invoice Bulletin Generator",ZTRTN="DQ^PRCFDBL",ZTSAVE("PRC*")="",ZTSAVE("DATE")="" D ^%ZTLOAD
. W !! S X="Request Queued.*" D MSG^PRCFQ K ZTSK
DQ N DA,CP,XMY,XMDUZ,XMTEXT,MSG,SITE,FCP,FCPTR,PRCFPO,X,ZX,ZXX,CNT,XMZ
K ^TMP($J) Q:'$D(^PRCF(421.5,"AC",PRCFDT))
S DA=0 F S DA=$O(^PRCF(421.5,"AC",PRCFDT,DA)) Q:'DA I $D(^PRCF(421.5,DA,2)),'$P(^(2),U,14) D
. S PRC("SITE")=+$P(^PRCF(421.5,DA,2),U,3)
. S FCPTR=$P($G(^PRCF(421.5,DA,0)),U,7) Q:'FCPTR
. S FCP=+$P($G(^PRC(442,FCPTR,0)),U,3) Q:'FCP
. S ^TMP($J,PRC("SITE"),FCP,DA)=""
S PRC("SITE")=0
F S PRC("SITE")=$O(^TMP($J,PRC("SITE"))) Q:'PRC("SITE") D
. S FCP=0 F S FCP=$O(^TMP($J,PRC("SITE"),FCP)) Q:'FCP D
. . S MSG(1)=" "
. . S MSG(2)="The following invoice(s) are DUE in Fiscal on "_DATE
. . S MSG(3)=" for Control Point "_$S($D(^PRC(420,PRC("SITE"),1,+FCP,0)):$P(^(0),U),1:"UNKNOWN FCP")_":"
. . S MSG(4)=" "
. . S CNT=4,DA=0 F S DA=$O(^TMP($J,PRC("SITE"),FCP,DA)) Q:'DA D
. . . S CNT=CNT+1,X=^PRCF(421.5,DA,0),MSG(CNT)="Tracking #: "
. . . S MSG(CNT)=MSG(CNT)_$P(X,U)_", Vendor: "
. . . S MSG(CNT)=MSG(CNT)_$S($P(X,U,8)]"":$P($G(^PRC(440,$P(X,U,8),0)),U),1:"UNKNOWN")
. . . S MSG(CNT)=MSG(CNT)_", Invoice #: "_$P(X,U,3)
. . . S PRCFPO=$P($G(^PRCF(421.5,DA,1)),U,3)
. . . S:PRCFPO]"" MSG(CNT)=MSG(CNT)_", PO#: "_PRCFPO
. . . Q
. . K XMY S ZX=0 F S ZX=$O(^PRC(420,PRC("SITE"),1,+FCP,1,ZX)) Q:'ZX I $P($G(^(ZX,0)),U,2)<3,$P(^(0),"^")]"" S XMY(ZX)=""
. . S XMDUZ=$S(+$G(PRC("PER")):+PRC("PER"),1:DUZ),XMY(XMDUZ)=""
. . S XMSUB="CERTIFIED INVOICES DUE IN FISCAL",XMTEXT="MSG("
. . S MSG(CNT+1)=" "
. . S MSG(CNT+2)="Please note and return to Fiscal prior to due date."
. . D ^XMD
. . S ZXX=0 F S ZXX=$O(^TMP($J,PRC("SITE"),FCP,ZXX)) Q:'ZXX S $P(^PRCF(421.5,ZXX,2),U,14)=1,$P(^(2),U,15)=DT,$P(^(2),U,16)=$G(XMZ)
. . K MSG,XMY
. . Q
. Q
S ZTREQ="@" K PRC,^TMP($J),DTOUT,DUOUT,DIRUT,DIROUT,PRCFDT,DATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFDBL 2662 printed Dec 13, 2024@02:02:51 Page 2
PRCFDBL ;WISC/CLH/LEM-BULLETIN GENERATOR FOR CI'S DUE ;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 NEW PRC,X,Y,%,DIR,PRCFDT,DATE
+3 SET X="T+7"
DO ^%DT
SET PRCFDT=Y
DO DD^%DT
SET DATE=Y
+4 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+5 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+6 WRITE !
SET DIR(0)="Y"
SET DIR("T")=120
SET DIR("A")="Okay to continue"
SET DIR("A",1)="This option generates bulletins to those services having"
SET DIR("A",2)="a Certified Invoice due in Fiscal on "_DATE_"."
SET DIR("?")="^D CI^PRCFHLP"
+7 SET DIR("A",3)=" "
SET DIR("A",4)="This job is scheduled to run on a daily basis"
SET DIR("A",5)="Are you sure you want to run this option manually?"
DO ^DIR
KILL DIR
+8 IF 'Y
QUIT
+9 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="Certified Invoice Bulletin Generator"
SET ZTRTN="DQ^PRCFDBL"
SET ZTSAVE("PRC*")=""
SET ZTSAVE("DATE")=""
DO ^%ZTLOAD
+10 WRITE !!
SET X="Request Queued.*"
DO MSG^PRCFQ
KILL ZTSK
End DoDot:1
QUIT
DQ NEW DA,CP,XMY,XMDUZ,XMTEXT,MSG,SITE,FCP,FCPTR,PRCFPO,X,ZX,ZXX,CNT,XMZ
+1 KILL ^TMP($JOB)
if '$DATA(^PRCF(421.5,"AC",PRCFDT))
QUIT
+2 SET DA=0
FOR
SET DA=$ORDER(^PRCF(421.5,"AC",PRCFDT,DA))
if 'DA
QUIT
IF $DATA(^PRCF(421.5,DA,2))
IF '$PIECE(^(2),U,14)
Begin DoDot:1
+3 SET PRC("SITE")=+$PIECE(^PRCF(421.5,DA,2),U,3)
+4 SET FCPTR=$PIECE($GET(^PRCF(421.5,DA,0)),U,7)
if 'FCPTR
QUIT
+5 SET FCP=+$PIECE($GET(^PRC(442,FCPTR,0)),U,3)
if 'FCP
QUIT
+6 SET ^TMP($JOB,PRC("SITE"),FCP,DA)=""
End DoDot:1
+7 SET PRC("SITE")=0
+8 FOR
SET PRC("SITE")=$ORDER(^TMP($JOB,PRC("SITE")))
if 'PRC("SITE")
QUIT
Begin DoDot:1
+9 SET FCP=0
FOR
SET FCP=$ORDER(^TMP($JOB,PRC("SITE"),FCP))
if 'FCP
QUIT
Begin DoDot:2
+10 SET MSG(1)=" "
+11 SET MSG(2)="The following invoice(s) are DUE in Fiscal on "_DATE
+12 SET MSG(3)=" for Control Point "_$SELECT($DATA(^PRC(420,PRC("SITE"),1,+FCP,0)):$PIECE(^(0),U),1:"UNKNOWN FCP")_":"
+13 SET MSG(4)=" "
+14 SET CNT=4
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,PRC("SITE"),FCP,DA))
if 'DA
QUIT
Begin DoDot:3
+15 SET CNT=CNT+1
SET X=^PRCF(421.5,DA,0)
SET MSG(CNT)="Tracking #: "
+16 SET MSG(CNT)=MSG(CNT)_$PIECE(X,U)_", Vendor: "
+17 SET MSG(CNT)=MSG(CNT)_$SELECT($PIECE(X,U,8)]"":$PIECE($GET(^PRC(440,$PIECE(X,U,8),0)),U),1:"UNKNOWN")
+18 SET MSG(CNT)=MSG(CNT)_", Invoice #: "_$PIECE(X,U,3)
+19 SET PRCFPO=$PIECE($GET(^PRCF(421.5,DA,1)),U,3)
+20 if PRCFPO]""
SET MSG(CNT)=MSG(CNT)_", PO#: "_PRCFPO
+21 QUIT
End DoDot:3
+22 KILL XMY
SET ZX=0
FOR
SET ZX=$ORDER(^PRC(420,PRC("SITE"),1,+FCP,1,ZX))
if 'ZX
QUIT
IF $PIECE($GET(^(ZX,0)),U,2)<3
IF $PIECE(^(0),"^")]""
SET XMY(ZX)=""
+23 SET XMDUZ=$SELECT(+$GET(PRC("PER")):+PRC("PER"),1:DUZ)
SET XMY(XMDUZ)=""
+24 SET XMSUB="CERTIFIED INVOICES DUE IN FISCAL"
SET XMTEXT="MSG("
+25 SET MSG(CNT+1)=" "
+26 SET MSG(CNT+2)="Please note and return to Fiscal prior to due date."
+27 DO ^XMD
+28 SET ZXX=0
FOR
SET ZXX=$ORDER(^TMP($JOB,PRC("SITE"),FCP,ZXX))
if 'ZXX
QUIT
SET $PIECE(^PRCF(421.5,ZXX,2),U,14)=1
SET $PIECE(^(2),U,15)=DT
SET $PIECE(^(2),U,16)=$GET(XMZ)
+29 KILL MSG,XMY
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 SET ZTREQ="@"
KILL PRC,^TMP($JOB),DTOUT,DUOUT,DIRUT,DIROUT,PRCFDT,DATE
+33 QUIT
