source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFFRFT.m@ 1499

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1IBDFFRFT ;ALB/CMR - AICS Free Forms Tracking Entry ; 27-MAR-97
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**15,38**;APR 24, 1997
3 ;
4 ; -- modified 10/7/97 to allow background freeing via site parameter
5 ;
6FREEFT ; -- called to pass data from FT to PCE regardless of whether all
7 ; pages have been received.
8 ;
9 N FORMTYPE,IBFID,IBD,IBNODE,DFN,CLINIC,APPT,Y,PXCA,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,CNT,ORVP,PXCAVSIT,RESULT,SDFN
10 D EN^VALM2($G(XQORNOD(0)))
11 I $D(VALMY) D FULL^VALM1 S IBD=0 F S IBD=$O(VALMY(IBD)) Q:'IBD!$D(DIRUT) D
12 .S IBFID=$P($G(^TMP("FRMIDX",$J,+IBD)),"^",2)
13 .S IBNODE=$G(^IBD(357.96,+IBFID,0)) I IBNODE="" W !,"No Form Tracking record associated with entry #",IBD H 2 Q
14 .I '$D(^XUSEC("IBD MANAGER",DUZ)) W !,"You must hold the IBD MANAGER key to free Forms Tracking entries" H 2 Q
15 .I $P(IBNODE,"^",11)'=11 W !,"You may only pass data to PCE if the current status is PENDING PAGES" H 2 Q
16 .S DFN=$P(IBNODE,"^",2),APPT=$P(IBNODE,"^",3),CLINIC=$P(IBNODE,"^",10)
17 .;
18 .; -- display ft data
19 .W !!,"PATIENT: ",$P($G(^DPT(DFN,0)),"^")," APPT DATE/TIME: ",$$FMTE^XLFDT(APPT,2),!,"CLINIC: ",$P($G(^SC(CLINIC,0)),"^"),!
20 .;
21 .; -- display page data
22 .S I=0 F S I=$O(^IBD(357.96,IBFID,9,I)) Q:'I S IBNODE=$G(^IBD(357.96,IBFID,9,I,0)) W !?5,"Page ",$P(IBNODE,"^")," ",$S(+$P(IBNODE,"^",2):"Received",1:"Not Received")
23 .W ! S DIR(0)="Y",DIR("A")="Okay to continue",DIR("B")="Y" D ^DIR K DIR Q:'Y
24 .D SEND(IBFID)
25 ;
26 D EXIT1^IBDFFT,START^IBDFFT1
27 S VALMBCK="R"
28 Q
29 ;
30SEND(IBFID,ERRCNT) ; -- send all page data in forms tracking
31 ;
32 ; -- gather data from previously stored pages
33 S I=0 F S I=$O(^IBD(357.96,IBFID,10,I)) Q:'I D ARYAD^IBDFBKR($G(^IBD(357.96,IBFID,10,I,0)))
34 ;
35 ; -- send data to pce
36 W:'$D(ZTQUEUED) !,"Sending Data to PCE..."
37 S RESULT=$$SEND^IBDF18E(IBFID,"","",.BUBBLES,.HANDPRNT,"",.PXCA,.DYNAMIC)
38 W:'$D(ZTQUEUED) $S(RESULT:"Successfull",1:"Unsuccessful")
39 ;
40 ; -- process any returned errors/warnings
41 I $D(PXCA("ERROR"))!($D(PXCA("WARNING"))) D
42 .N I,J,ERR,LCNT,DIR,DIRUT,DUOUT
43 .S LCNT=0,ERRCNT=$G(ERRCNT)+1
44 .D EW^IBDFBK2(.ERR,.PXCA,.LCNT)
45 .;
46 .W:'$D(ZTQUEUED) !!!,"The following Error(s) occurred while validating data in PCE for: ",$P($G(^DPT(DFN,0)),"^")
47 .Q:$D(ZTQUEUED)
48 .S I=0 F S I=$O(ERR(I)) Q:'I W !?4,$E(ERR(I),1,75) I $L(ERR(I))>75 W !?10,$E(ERR(I),76,140)
49 .W !!
50 Q
51 ;
52BCKGRND ; -- entry point for back ground job to process pending pages
53 ;
54 N DAYS,START,END
55 S DAYS=+$P($G(^IBD(357.09,1,0)),"^",11)
56 ;
57 Q:'DAYS
58 S ERRCNT=0
59 S START=DAYS+7
60 S START=$$FMADD^XLFDT(DT,-START)
61 S END=$$FMADD^XLFDT(DT,-DAYS)+.24
62 ;
63B1 N CNT,ERRCNT,IBFID,STATUS
64 F S START=$O(^IBD(357.96,"D",START)) Q:'START!(START>END) D
65 .S IBFID=0
66 .F S IBFID=$O(^IBD(357.96,"D",START,IBFID)) Q:'IBFID D
67 ..S STATUS=$P($G(^IBD(357.96,IBFID,0)),"^",11)
68 ..I STATUS=11 S CNT=$G(CNT)+1 D SEND(IBFID,.ERRCNT)
69 ;
70 D:$G(MANUAL) BULL
71 I $D(ZTQUEUED),$G(MANUAL) S ZTREQ="@"
72 Q
73 ;
74BULL ; -- add bulletin or something to let people know what was done
75 ; but only if they ask for it during testing.
76 ;
77 S IBD(1)="The background job to release pending pages has completed"
78 S IBD(2)=""
79 S IBD(3)=" Number of Forms Tracking Entries: "_+$G(CNT)
80 S IBD(4)=" Number of Forms Generating Errors: "_+$G(ERRCNT)
81 S XMSUB="AICS RELEASE PENDING PAGES"
82 S XMDUZ="AICS PACKAGE",XMTEXT="IBD("
83 K XMY S XMN=0
84 S XMY(DUZ)=""
85 D ^XMD
86 K X,Y,IBD,XMDUZ,XMTEXT,XMY,XMSUB,XMN
87 Q
88 ;
89MANUAL ; -- entry point for sending pending pages to PCE for a date range
90 ; get date range and do b1
91 ;
92 W !!,"Option to Manually send Encounter Forms in a Pending Pages Status in Forms"
93 W !,"Tracking to PCE by Encounter date range.",!!
94 ;
95 S MANUAL=1
96 S DAYS=+$P($G(^IBD(357.09,1,0)),"^",11)
97 S HELP="Enter a START date. This is an exact date and should be in the past."
98 S START=$$ASKDT("Start Date: ","T-"_(60+DAYS),"AEPQX","",DT,.HELP,"D SHELP^IBDFFRFT")
99 I START<1 G MQ
100 S HELP="Enter the END date. This must be after the start date an before today."
101 S END=$$ASKDT("End Date: ","T-"_$S(DAYS:DAYS,1:15),"AEQX",START,DT,.HELP,"D EHELP^IBDFFRFT")
102 I END<1!(END<START) G MQ
103 S ZTRTN="B1^IBDFFRFT",ZTSAVE("START")="",ZTSAVE("END")="",ZTSAVE("DAYS")="",ZTSAVE("MANUAL")=""
104 S ZTDESC="IBD-FREE FORMS TRACKING OF PENDING PAGES"
105 S ZTIO=""
106 W !!,"This option must be queued. No Device is Necessary."
107 W !,"A mail message will be sent when the process has completed.",!!
108 D ^%ZTLOAD
109MQ K X,Y,IBD,DAYS,START,END,MANUAL,HELP,ZTSK,ZTRTN,ZTSAVE,ZTSAVE,ZTDESC,ZTIO
110 Q
111 ;
112EHELP ; -- help for the end date prompt
113 W !,"Enter the END date. This is an Encounter Date."
114 W !,"This is the last date that forms that are in a Pending Pages Status in Forms"
115 W !,"Tracking will be automatically sent to PCE for processing."
116 Q
117 ;
118SHELP ; -- help for start date prompt
119 W !,"Enter the START date. This is an Encounter Date."
120 W !,"This is the date that you want to start the process that sends forms that"
121 W !,"are in a Pending Pages Status in Forms Tracking entries to PCE to start on."
122 Q
123 ;
124ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,HELP,EXHELP) ; -- ask date questions
125 N X,Y,DIR,DIRUT,DTOUT,DUOUT,IBQUIT
126 S DIR(0)="DOA^"_$E($G(EARLY),1,7)_":"_$G(LATEST)_":"_$S($G(PARAM)'="":PARAM,1:"AEQRX")
127 I $G(QUES)'="" S DIR("A")=QUES
128 I $G(DEFLT)'="" S DIR("B")=DEFLT
129 I $L($G(EXHELP)) S DIR("??")="^"_EXHELP
130 I $D(HELP) M DIR("?")=HELP
131 D ^DIR
132 I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
133 I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
134 Q Y
Note: See TracBrowser for help on using the repository browser.