47 lines
2.6 KiB
Mathematica
47 lines
2.6 KiB
Mathematica
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
|