Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETCO.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETCO.m
r613 r623 1 PXRMETCO ; SLC/PJH - QUERI Extract Compliance Report ;03/27/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ; 5 ADHOC(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 ; 15 REPORT ;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. 85 JOB ; 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 ; 99 EXIT ;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 ; 109 SAVE ;Save the variables for queing. 110 S ZTSAVE("IEN")="" 111 S ZTSAVE("PXRMSTRT")="" 112 S ZTSAVE("PXRMSTOP")="" 113 Q 114 ; 115 ; 116 QUE ;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 1 PXRMETCO ; SLC/PJH - QUERI Extract Compliance Report ;01/19/2005 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ; 5 ADHOC(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 ; 15 REPORT ;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 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 .;Create new patient list 44 .S PXRMLIST=$$CRLST^PXRMRULE(LIST_" "_SUFFIX) Q:'PXRMLIST 45 .D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,"","") 46 .;Clear ^TMP lists created for rule 47 .D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE) 48 .;Process reminders 49 .D REM^PXRMETXR(SUB,PXRMLIST) 50 ; 51 ;Bookmark - Report stuff goes here 52 ;Update totals section 53 N APPL,DUE,DATA,ETYP,EVAL 54 N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FIND,FNAPPL,FNDUE,FSEQ 55 N NAPPL,NDUE,PXRMLIST,RCNT,RIEN,RSEQ,SEQ 56 S SEQ=0,CNT=1 57 F S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:'SEQ D 58 .S RCNT=0,RSEQ=0 59 .F S RCNT=$O(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'RCNT D 60 ..S DATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'DATA 61 ..S RIEN=$P(DATA,U),PXRMLIST=$P(DATA,U,5) 62 ..S EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3),DUE=$P(DATA,U,4) 63 ..S NAPPL=EVAL-APPL,NDUE=APPL-DUE 64 ..S CNT=CNT+1,RSEQ=RSEQ+1 65 ..;bookmark - write patient line 66 ..;For each count type 67 ..S ETYP="",FCNT=CNT 68 ..F S ETYP=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP)) Q:ETYP="" D 69 ...;For each term 70 ...S FIND=0,FSEQ=0 71 ...F S FIND=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)) Q:FIND="" D 72 ....;Update finding totals 73 ....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)),FCNT=FCNT+1 74 ....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FDUE=$P(FDATA,U,4) 75 ....S FNAPPL=FEVAL-FAPPL,FNDUE=FAPPL-FDUE 76 ....S FSEQ=FSEQ+1,FGNAM=$P(DATA,U,9) 77 ....;Bookmark - write finding line 78 ..;Update CNT 79 ..S CNT=FCNT 80 Q 81 ; 82 ;Determine whether the report should be queued. 83 JOB ; 84 N %ZIS,ZTDESC,ZTSAVE,ZTRTN,ZTSK 85 S DBDUZ=DUZ 86 D SAVE^PXRMXQUE 87 S %ZIS="Q" 88 S ZTDESC="QUERI Compliance Report - print" 89 S ZTRTN="REPORT^PXRMETCO" 90 S ZTSK=1 91 S PXRMQUE=0 92 S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK) 93 I PXRMQUE=1 G EXIT 94 I PXRMQUE>0 S ^XTMP(PXRMXTMP,"PRZTSK")=PXRMQUE 95 Q 96 ; 97 EXIT ;Clean things up. 98 D ^%ZISC 99 D HOME^%ZIS 100 K IO("Q") 101 K DIRUT,DTOUT,DUOUT,POP,ZTREQ 102 I $D(ZTSK) D KILL^%ZTLOAD 103 K ZTSK,ZTQUEUED 104 K ^TMP("PXRMXTR",$J) 105 Q 106 ; 107 SAVE ;Save the variables for queing. 108 S ZTSAVE("IEN")="" 109 S ZTSAVE("PXRMSTRT")="" 110 S ZTSAVE("PXRMSTOP")="" 111 Q 112 ; 113 ; 114 QUE ;BOOKMARK - NOT USED 115 ;Queue the MST synchronization job. 116 N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y 117 S MINDT=$$NOW^XLFDT 118 W !,"Queue the Clinical Reminders MST synchronization." 119 S DIR("A",1)="Enter the date and time you want the job to start." 120 S DIR("A")="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")_" " 121 S DIR(0)="DAU"_U_MINDT_"::RSX" 122 D ^DIR 123 I $D(DTOUT)!$D(DUOUT) Q 124 S SDTIME=Y 125 K DIR 126 S DIR(0)="YA" 127 S DIR("A")="Do you want to run the MST synchronization at the same time every day? " 128 S DIR("B")="Y" 129 D ^DIR 130 I $D(DTOUT)!$D(DUOUT) Q 131 I Y S STIME="1."_$P(SDTIME,".",2) 132 E S STIME=-1 133 ; 134 ;Put the task into the queue. 135 K ZTSAVE 136 ;S ZTSAVE("START")=SDTIME 137 S ZTSAVE("STIME")=STIME 138 S ZTRTN="SYNCH^PXRMMST" 139 S ZTDESC="Clinical Reminders MST synchronization job" 140 S ZTDTH=SDTIME 141 S ZTIO="" 142 D ^%ZTLOAD 143 W !,"Task number ",ZTSK," queued." 144 Q
Note:
See TracChangeset
for help on using the changeset viewer.
