source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETCO.m@ 1553

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PXRMETCO ; SLC/PJH - QUERI Extract Compliance Report ;03/27/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;
5ADHOC(IEN,PXRMSTRT,PXRMSTOP) ;Ad Hoc Conformance Report
6 D DUMMY1^PXRMRUTL
7 Q
8 ;
9 D JOB
10 Q
11 ;
12 ;BOOKMARK - cloned from PXRMETX, needs modifying to avoid patient list
13 ;update. Build ^TMP("PXRMETX",$J) for report
14 ;
15REPORT ;Initialise
16 K ^TMP("PXRMETX",$J)
17 ;Workfile node for ^TMP
18 S PXRMNODE="PXRMRULE"
19 ;Get details from parameter file
20 N DATA,DATES,LIST,NAME,PARTYPE,TEXT
21 ;N PERIOD,TEXT,YEAR
22 S DATA=$G(^PXRM(810.2,IEN,0))
23 ;
24 ;Determine Extract Name and period
25 S NAME=$P(DATA,U),PARTYPE=$P(DATA,U,2)
26 ;S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
27 ;Calculate report period start and end dates
28 ;D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
29 ;Determine output name for patient list and extract summary
30 S DATES=$$FMTE^XLFDT(PXRMSTRT)_" - "_$$FMTE^XLFDT(PXRMSTOP)
31 ;
32 ;Bookmark - Needs inventive patient list names
33 S LIST=NAME_" REPORT "_DATES
34 ;Process (single) Denominator rule into patient list
35 N INDP,INTP,SEQ,SUB,SUFFIX
36 S SEQ=""
37 F S SEQ=$O(^PXRM(810.2,IEN,10,"B",SEQ)) Q:'SEQ D
38 .S SUB=$O(^PXRM(810.2,IEN,10,"B",SEQ,"")) Q:'SUB
39 .S DATA=$G(^PXRM(810.2,IEN,10,SUB,0)) Q:DATA=""
40 .S PXRMRULE=$P(DATA,U,2) Q:'PXRMRULE
41 .S SUFFIX=$P(DATA,U,3)
42 .I SUFFIX="" S SUFFIX="DENOMINATOR "_SEQ
43 .S INDP=+$P(DATA,U,4)
44 .S INTP=+$P(DATA,U,5)
45 .;Create new patient list
46 .S PXRMLIST=$$CRLST^PXRMRUL1(LIST_" "_SUFFIX) Q:'PXRMLIST
47 .D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,INDP,INTP)
48 .;Clear ^TMP lists created for rule
49 .D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
50 .;Process reminders
51 .D REM^PXRMETXR(SUB,PXRMLIST)
52 ;
53 ;Bookmark - Report stuff goes here
54 ;Update totals section
55 N APPL,DUE,DATA,ETYP,EVAL
56 N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FIND,FNAPPL,FNDUE,FSEQ
57 N NAPPL,NDUE,PXRMLIST,RCNT,RIEN,RSEQ,SEQ
58 S SEQ=0,CNT=1
59 F S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:'SEQ D
60 .S RCNT=0,RSEQ=0
61 .F S RCNT=$O(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'RCNT D
62 ..S DATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'DATA
63 ..S RIEN=$P(DATA,U),PXRMLIST=$P(DATA,U,5)
64 ..S EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3),DUE=$P(DATA,U,4)
65 ..S NAPPL=EVAL-APPL,NDUE=APPL-DUE
66 ..S CNT=CNT+1,RSEQ=RSEQ+1
67 ..;bookmark - write patient line
68 ..;For each count type
69 ..S ETYP="",FCNT=CNT
70 ..F S ETYP=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP)) Q:ETYP="" D
71 ...;For each term
72 ...S FIND=0,FSEQ=0
73 ...F S FIND=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)) Q:FIND="" D
74 ....;Update finding totals
75 ....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)),FCNT=FCNT+1
76 ....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FDUE=$P(FDATA,U,4)
77 ....S FNAPPL=FEVAL-FAPPL,FNDUE=FAPPL-FDUE
78 ....S FSEQ=FSEQ+1,FGNAM=$P(DATA,U,9)
79 ....;Bookmark - write finding line
80 ..;Update CNT
81 ..S CNT=FCNT
82 Q
83 ;
84 ;Determine whether the report should be queued.
85JOB ;
86 N %ZIS,ZTDESC,ZTSAVE,ZTRTN,ZTSK
87 S DBDUZ=DUZ
88 D SAVE^PXRMXQUE
89 S %ZIS="Q"
90 S ZTDESC="QUERI Compliance Report - print"
91 S ZTRTN="REPORT^PXRMETCO"
92 S ZTSK=1
93 S PXRMQUE=0
94 S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK)
95 I PXRMQUE=1 G EXIT
96 I PXRMQUE>0 S ^XTMP(PXRMXTMP,"PRZTSK")=PXRMQUE
97 Q
98 ;
99EXIT ;Clean things up.
100 D ^%ZISC
101 D HOME^%ZIS
102 K IO("Q")
103 K DIRUT,DTOUT,DUOUT,POP,ZTREQ
104 I $D(ZTSK) D KILL^%ZTLOAD
105 K ZTSK,ZTQUEUED
106 K ^TMP("PXRMXTR",$J)
107 Q
108 ;
109SAVE ;Save the variables for queing.
110 S ZTSAVE("IEN")=""
111 S ZTSAVE("PXRMSTRT")=""
112 S ZTSAVE("PXRMSTOP")=""
113 Q
114 ;
115 ;
116QUE ;BOOKMARK - NOT USED
117 ;Queue the MST synchronization job.
118 N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
119 S MINDT=$$NOW^XLFDT
120 W !,"Queue the Clinical Reminders MST synchronization."
121 S DIR("A",1)="Enter the date and time you want the job to start."
122 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
123 S DIR("A")="Start the task at: "
124 S DIR(0)="DAU"_U_MINDT_"::RSX"
125 D ^DIR
126 I $D(DTOUT)!$D(DUOUT) Q
127 S SDTIME=Y
128 K DIR
129 S DIR(0)="YA"
130 S DIR("A")="Do you want to run the MST synchronization at the same time every day? "
131 S DIR("B")="Y"
132 D ^DIR
133 I $D(DTOUT)!$D(DUOUT) Q
134 I Y S STIME="1."_$P(SDTIME,".",2)
135 E S STIME=-1
136 ;
137 ;Put the task into the queue.
138 K ZTSAVE
139 ;S ZTSAVE("START")=SDTIME
140 S ZTSAVE("STIME")=STIME
141 S ZTRTN="SYNCH^PXRMMST"
142 S ZTDESC="Clinical Reminders MST synchronization job"
143 S ZTDTH=SDTIME
144 S ZTIO=""
145 D ^%ZTLOAD
146 W !,"Task number ",ZTSK," queued."
147 Q
Note: See TracBrowser for help on using the repository browser.