source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFDBL.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PRCFDBL ;WISC/CLH/LEM-BULLETIN GENERATOR FOR CI'S DUE ;7/19/95 14:30
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N PRC,X,Y,%,DIR,PRCFDT,DATE
5 S X="T+7" D ^%DT S PRCFDT=Y D DD^%DT S DATE=Y
6 I '$D(ZTQUEUED) D Q
7 . S PRCF("X")="AS" D ^PRCFSITE Q:'%
8 . 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"
9 . 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
10 . I 'Y Q
11 . S ZTDTH=$H,ZTIO="",ZTDESC="Certified Invoice Bulletin Generator",ZTRTN="DQ^PRCFDBL",ZTSAVE("PRC*")="",ZTSAVE("DATE")="" D ^%ZTLOAD
12 . W !! S X="Request Queued.*" D MSG^PRCFQ K ZTSK
13DQ N DA,CP,XMY,XMDUZ,XMTEXT,MSG,SITE,FCP,FCPTR,PRCFPO,X,ZX,ZXX,CNT,XMZ
14 K ^TMP($J) Q:'$D(^PRCF(421.5,"AC",PRCFDT))
15 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
16 . S PRC("SITE")=+$P(^PRCF(421.5,DA,2),U,3)
17 . S FCPTR=$P($G(^PRCF(421.5,DA,0)),U,7) Q:'FCPTR
18 . S FCP=+$P($G(^PRC(442,FCPTR,0)),U,3) Q:'FCP
19 . S ^TMP($J,PRC("SITE"),FCP,DA)=""
20 S PRC("SITE")=0
21 F S PRC("SITE")=$O(^TMP($J,PRC("SITE"))) Q:'PRC("SITE") D
22 . S FCP=0 F S FCP=$O(^TMP($J,PRC("SITE"),FCP)) Q:'FCP D
23 . . S MSG(1)=" "
24 . . S MSG(2)="The following invoice(s) are DUE in Fiscal on "_DATE
25 . . S MSG(3)=" for Control Point "_$S($D(^PRC(420,PRC("SITE"),1,+FCP,0)):$P(^(0),U),1:"UNKNOWN FCP")_":"
26 . . S MSG(4)=" "
27 . . S CNT=4,DA=0 F S DA=$O(^TMP($J,PRC("SITE"),FCP,DA)) Q:'DA D
28 . . . S CNT=CNT+1,X=^PRCF(421.5,DA,0),MSG(CNT)="Tracking #: "
29 . . . S MSG(CNT)=MSG(CNT)_$P(X,U)_", Vendor: "
30 . . . S MSG(CNT)=MSG(CNT)_$S($P(X,U,8)]"":$P($G(^PRC(440,$P(X,U,8),0)),U),1:"UNKNOWN")
31 . . . S MSG(CNT)=MSG(CNT)_", Invoice #: "_$P(X,U,3)
32 . . . S PRCFPO=$P($G(^PRCF(421.5,DA,1)),U,3)
33 . . . S:PRCFPO]"" MSG(CNT)=MSG(CNT)_", PO#: "_PRCFPO
34 . . . Q
35 . . 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)=""
36 . . S XMDUZ=$S(+$G(PRC("PER")):+PRC("PER"),1:DUZ),XMY(XMDUZ)=""
37 . . S XMSUB="CERTIFIED INVOICES DUE IN FISCAL",XMTEXT="MSG("
38 . . S MSG(CNT+1)=" "
39 . . S MSG(CNT+2)="Please note and return to Fiscal prior to due date."
40 . . D ^XMD
41 . . 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)
42 . . K MSG,XMY
43 . . Q
44 . Q
45 S ZTREQ="@" K PRC,^TMP($J),DTOUT,DUOUT,DIRUT,DIROUT,PRCFDT,DATE
46 Q
Note: See TracBrowser for help on using the repository browser.