Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEPM.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/PXRMEPM.m
r613 r623 1 PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;07/17/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;Main entry point for PXRM EXTRACT DEFINITIONS 5 START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0 9 D EN^VALM("PXRM EXTRACT DEFINITIONS") 10 Q 11 ; 12 BLDLIST ;Build workfile 13 K ^TMP("PXRMEPM",$J) 14 N IEN,IND,PLIST 15 D LIST^PXRMETM("PXRMEPM",.VALMCNT) 16 Q 17 ; 18 ENTRY ;Entry code 19 D BLDLIST,XQORM 20 Q 21 ; 22 EXIT ;Exit code 23 K ^TMP("PXRMEPM",$J) 24 K ^TMP("PXRMEPMH",$J) 25 D CLEAN^VALM10 26 D FULL^VALM1 27 S VALMBCK="Q" 28 Q 29 ; 30 HDR ; Header code 31 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 32 Q 33 ; 34 HLP ;Help code 35 N ORU,ORUPRMT,SUB,XQORM 36 S SUB="PXRMEPMH" 37 D EN^VALM("PXRM EXTRACT HELP") 38 Q 39 ; 40 INIT ;Init 41 S VALMCNT=0 42 Q 43 ; 44 PEXIT ;PXRM EXCH MENU protocol exit code 45 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 46 ;Reset after page up/down etc 47 D XQORM 48 Q 49 ; 50 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT 51 S XQORM("A")="Select Item: " 52 Q 53 ; 54 XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation 55 N SEL,IEN 56 S SEL=$P(XQORNOD(0),"=",2) 57 ;Remove trailing , 58 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 59 ;Invalid selection 60 I SEL["," D Q 61 .W $C(7),!,"Only one item number allowed." H 2 62 .S VALMBCK="R" 63 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q 64 .W $C(7),!,SEL_" is not a valid item number." H 2 65 .S VALMBCK="R" 66 ; 67 ;Get the list ien. 68 S IEN=^TMP("PXRMEPM",$J,"SEL",SEL) 69 ;Display/Edit Extract Definition 70 D START^PXRMEPED(IEN) 71 D BLDLIST 72 S VALMBCK="R" 73 Q 74 ; 75 HELP(CALL) ;General help text routine 76 N HTEXT 77 I CALL=1 D 78 .S HTEXT(1)="Select DE to display or edit a definition." 79 .S HTEXT(2)="Select ED to edit a definition" 80 D HELP^PXRMEUT(.HTEXT) 81 Q 82 ; 83 EPADD ;Add Rule Option 84 ;Reset Screen Mode 85 W IORESET 86 ; 87 ;Add Rule 88 D ADD^PXRMEPED 89 ; 90 ;Rebuild Workfile 91 D BLDLIST 92 S VALMBCK="R" 93 Q 94 ; 95 EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry 96 N IND,LRIEN,VALMY 97 D EN^VALM2(XQORNOD(0)) 98 ; 99 ;If there is no list quit. 100 I '$D(VALMY) Q 101 S PXRMDONE=0 102 S IND="" 103 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 104 .;Get the ien. 105 .S LRIEN=^TMP("PXRMEPM",$J,"SEL",IND) 106 .D START^PXRMEPED(LRIEN) 107 D BLDLIST 108 S VALMBCK="R" 109 Q 110 ; 111 PPLR ;Display rule set components 112 ;used by [PXRM EXTRACT DEFINITION] template) 113 N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB 114 S IEN=$P(X,U,2) Q:'IEN 115 W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2) 116 S SEQ="",FIRST=1 117 F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D 118 .S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB 119 .S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA="" 120 .S LRIEN=$P(DATA,U,2) Q:LRIEN="" 121 .S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0)) 122 .I FIRST W !!,?2,"List Rules:" S FIRST=0 123 .W !,?2,SEQ,?7,$P(LRDATA,U),?66 124 .W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT") 125 .;Display List Rule fields 126 .D LROUT^PXRMLRED(LRIEN,23) 127 .W ! 128 Q 129 ; 130 PPFR ;Display counting rules and count type 131 ;used by [PXRM EXTRACT DEFINITION] template) 132 W ! 133 N DATA,GIEN,GSTATUS,IEN,SEQ,SUB 134 S IEN=$P(X,U,3) Q:'IEN 135 S SEQ="" 136 F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D 137 .S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB 138 .S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA="" 139 .S GIEN=$P(DATA,U,2) Q:GIEN="" 140 .S GSTATUS=$P(DATA,U,3) 141 .;Get counting groups 142 .N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB 143 .S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U) 144 .S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1 145 .S CTXT=$$TXT(CTYP,GSTATUS) 146 .F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D 147 ..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB 148 ..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA="" 149 ..S TIEN=$P(DATA,U,2) Q:TIEN="" 150 ..S EXCL=$P(DATA,U,3) Q:EXCL="E" 151 ..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) 152 ..I FIRST D 153 ...W !,?14,SEQ 154 ...W ?18,"Counting Group: ",GNAME 155 ...W !,?18,$$TXT(CTYP,GSTATUS) 156 ...W !,?23,"Terms:" S FIRST=0 157 ..W ?30,TNAME,! 158 Q 159 ; 160 SCREEN ;Screen for 810.210 field .02 161 S DIC("S")="I $P(^(0),U,3)=3" 162 Q 163 ; 164 TXT(COUNT,COHORT) ;Text to describe group 165 N TXT 166 ;Determine count type 167 I COUNT="MRFP" S TXT="Most recent finding patient counts for " 168 I COUNT="MRF" S TXT="Most recent finding counts for " 169 I COUNT="UR" S TXT="Utilization in period finding counts for " 170 ;Error 171 I $G(TXT)="" Q "Unknown count type - error" 172 ;Determine cohort 173 S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients" 174 Q TXT 1 PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;06/21/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Main entry point for PXRM EXTRACT DEFINITIONS 5 START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0 9 D EN^VALM("PXRM EXTRACT DEFINITIONS") 10 Q 11 ; 12 BLDLIST ;Build workfile 13 K ^TMP("PXRMEPM",$J) 14 N IEN,IND,PLIST 15 D LIST^PXRMETM(.PLIST,.IEN) 16 M ^TMP("PXRMEPM",$J)=PLIST 17 S VALMCNT=PLIST("VALMCNT") 18 F IND=1:1:VALMCNT D 19 .S ^TMP("PXRMEPM",$J,"IDX",IND,IND)=IEN(IND) 20 Q 21 ; 22 ENTRY ;Entry code 23 D BLDLIST,XQORM 24 Q 25 ; 26 EXIT ;Exit code 27 K ^TMP("PXRMEPM",$J) 28 K ^TMP("PXRMEPMH",$J) 29 D CLEAN^VALM10 30 D FULL^VALM1 31 S VALMBCK="Q" 32 Q 33 ; 34 HDR ; Header code 35 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 36 Q 37 ; 38 HLP ;Help code 39 N ORU,ORUPRMT,SUB,XQORM 40 S SUB="PXRMEPMH" 41 D EN^VALM("PXRM EXTRACT HELP") 42 Q 43 ; 44 INIT ;Init 45 S VALMCNT=0 46 Q 47 ; 48 PEXIT ;PXRM EXCH MENU protocol exit code 49 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 50 ;Reset after page up/down etc 51 D XQORM 52 Q 53 ; 54 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT 55 S XQORM("A")="Select Item: " 56 Q 57 ; 58 XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation 59 N SEL,IEN 60 S SEL=$P(XQORNOD(0),"=",2) 61 ;Remove trailing , 62 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 63 ;Invalid selection 64 I SEL["," D Q 65 .W $C(7),!,"Only one item number allowed." H 2 66 .S VALMBCK="R" 67 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q 68 .W $C(7),!,SEL_" is not a valid item number." H 2 69 .S VALMBCK="R" 70 ; 71 ;Get the list ien. 72 S IEN=^TMP("PXRMEPM",$J,"IDX",SEL,SEL) 73 ;Display/Edit Extract Definition 74 D START^PXRMEPED(IEN) 75 D BLDLIST 76 S VALMBCK="R" 77 Q 78 ; 79 HELP(CALL) ;General help text routine 80 N HTEXT 81 I CALL=1 D 82 .S HTEXT(1)="Select DE to display or edit a definition." 83 .S HTEXT(2)="Select ED to edit a definition" 84 D HELP^PXRMEUT(.HTEXT) 85 Q 86 ; 87 EPADD ;Add Rule Option 88 ; 89 ;Reset Screen Mode 90 W IORESET 91 ; 92 ;Add Rule 93 D ADD^PXRMEPED 94 ; 95 ;Rebuild Workfile 96 D BLDLIST 97 ; 98 S VALMBCK="R" 99 Q 100 ; 101 EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry 102 N IND,LRIEN,VALMY 103 D EN^VALM2(XQORNOD(0)) 104 ; 105 ;If there is no list quit. 106 I '$D(VALMY) Q 107 S PXRMDONE=0 108 S IND="" 109 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 110 .;Get the ien. 111 .S LRIEN=^TMP("PXRMEPM",$J,"IDX",IND,IND) 112 .D START^PXRMEPED(LRIEN) 113 D BLDLIST 114 S VALMBCK="R" 115 Q 116 ; 117 PPLR ;Display rule set components 118 ;used by [PXRM EXTRACT DEFINITION] template) 119 N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB 120 S IEN=$P(X,U,2) Q:'IEN 121 W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2) 122 S SEQ="",FIRST=1 123 F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D 124 .S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB 125 .S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA="" 126 .S LRIEN=$P(DATA,U,2) Q:LRIEN="" 127 .S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0)) 128 .I FIRST W !!,?2,"List Rules:" S FIRST=0 129 .W !,?2,SEQ,?7,$P(LRDATA,U),?66 130 .W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT") 131 .;Display List Rule fields 132 .D LROUT^PXRMLRED(LRIEN,23) 133 .W ! 134 Q 135 ; 136 PPFR ;Display counting rules and count type 137 ;used by [PXRM EXTRACT DEFINITION] template) 138 W ! 139 N DATA,GIEN,GSTATUS,IEN,SEQ,SUB 140 S IEN=$P(X,U,3) Q:'IEN 141 S SEQ="" 142 F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D 143 .S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB 144 .S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA="" 145 .S GIEN=$P(DATA,U,2) Q:GIEN="" 146 .S GSTATUS=$P(DATA,U,3) 147 .;Get counting groups 148 .N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB 149 .S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U) 150 .S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1 151 .S CTXT=$$TXT(CTYP,GSTATUS) 152 .F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D 153 ..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB 154 ..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA="" 155 ..S TIEN=$P(DATA,U,2) Q:TIEN="" 156 ..S EXCL=$P(DATA,U,3) Q:EXCL="E" 157 ..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) 158 ..I FIRST D 159 ...W !,?14,SEQ 160 ...W ?18,"Counting Group: ",GNAME 161 ...W !,?18,$$TXT(CTYP,GSTATUS) 162 ...W !,?23,"Terms:" S FIRST=0 163 ..W ?30,TNAME,! 164 Q 165 ; 166 SCREEN ;Screen for 810.210 field .02 167 S DIC("S")="I $P(^(0),U,3)=3" 168 Q 169 ; 170 TXT(COUNT,COHORT) ;Text to describe group 171 N TXT 172 ;Determine count type 173 I COUNT="MRFP" S TXT="Most recent finding patient counts for " 174 I COUNT="MRF" S TXT="Most recent finding counts for " 175 I COUNT="UR" S TXT="Utilization in period finding counts for " 176 ;Error 177 I $G(TXT)="" Q "Unknown count type - error" 178 ;Determine cohort 179 S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients" 180 Q TXT
Note:
See TracChangeset
for help on using the changeset viewer.
