Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLRM.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/PXRMLRM.m
r613 r623 1 PXRMLRM ; SLC/PJH/PKR - List Rule Management ; 09/06/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;Main entry point for PXRM LIST RULE MANAGEMENT 5 START N PXRMDONE,PXRMTYP,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0 9 ;Default view is Rule Sets 10 S PXRMTYP=3 11 D EN^VALM("PXRM LIST RULE MANAGEMENT") 12 Q 13 ; 14 BLDLIST ;Build workfile 15 K ^TMP("PXRMLRM",$J) 16 N IEN,IND,PLIST 17 D LIST(.PLIST,.IEN,PXRMTYP) 18 M ^TMP("PXRMLRM",$J)=PLIST 19 S VALMCNT=PLIST("VALMCNT") 20 F IND=1:1:VALMCNT D 21 .S ^TMP("PXRMLRM",$J,"IDX",IND,IND)=IEN(IND) 22 I PXRMTYP=1 D CHGCAP^VALM("HEADER2","Finding Rule Name") 23 I PXRMTYP=2 D CHGCAP^VALM("HEADER2","Reminder Rule Name") 24 I PXRMTYP=3 D CHGCAP^VALM("HEADER2","Rule Set Name") 25 I PXRMTYP=4 D CHGCAP^VALM("HEADER2","Report Output Rule Name") 26 I PXRMTYP=5 D CHGCAP^VALM("HEADER2","Patient List Rule Name") 27 Q 28 ; 29 ENTRY ;Entry code 30 D BLDLIST,XQORM 31 Q 32 ; 33 EXIT ;Exit code 34 K ^TMP("PXRMLRM",$J) 35 K ^TMP("PXRMLRMH",$J) 36 D CLEAN^VALM10 37 D FULL^VALM1 38 S VALMBCK="Q" 39 Q 40 ; 41 FRE(NUMBER,NAME,CLASS) ;Format entry number, name 42 ;and date packed. 43 N TCLASS,TEMP,TNAME,TSOURCE 44 S TEMP=$$RJ^XLFSTR(NUMBER,5," ") 45 S TNAME=$E(NAME,1,60) 46 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ") 47 S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL") 48 S TEMP=TEMP_" "_TCLASS 49 Q TEMP 50 ; 51 HDR ; Header code 52 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 53 Q 54 ; 55 HELP(CALL) ;General help text routine 56 N HTEXT 57 I CALL=1 D 58 .S HTEXT(1)="Select DE to display or edit a rule.\\" 59 .S HTEXT(2)="Select ED to edit a rule.\\" 60 ; 61 I CALL=2 D 62 .S HTEXT(1)="Select F to edit term based finding rules.\\" 63 .S HTEXT(2)="Select P to edit patient list based finding rules.\\" 64 .S HTEXT(3)="Select R to edit reminder rules.\\" 65 .S HTEXT(4)="Select S to edit rule sets. A rule set may contain" 66 .S HTEXT(5)="any of the following:\\" 67 .S HTEXT(6)=" finding list rules, patient list rules, reminder rules\\" 68 .S HTEXT(7)="These component list rules must be created before the rule set" 69 .S HTEXT(8)="can be constructed." 70 ; 71 D HELP^PXRMEUT(.HTEXT) 72 Q 73 ; 74 HLP ;Help code 75 N ORU,ORUPRMT,SUB,XQORM 76 S SUB="PXRMLRMH" 77 D EN^VALM("PXRM LIST RULE HELP") 78 Q 79 ; 80 INIT ;Init 81 S VALMCNT=0 82 Q 83 ; 84 LIST(RLIST,IEN,LRTYP) ;Build a list of list rule entries. 85 N DATA,IND,LRCLASS,LRNAME,NAME 86 ;Build the list in alphabetical order. 87 S VALMCNT=0 88 S NAME="" 89 F S NAME=$O(^PXRM(810.4,"B",NAME)) Q:NAME="" D 90 .S IND=$O(^PXRM(810.4,"B",NAME,"")) Q:'IND 91 .S DATA=$G(^PXRM(810.4,IND,0)) 92 .I $P(DATA,U,3)'=LRTYP Q 93 .S LRNAME=$P(DATA,U) 94 .S LRCLASS=$P($G(^PXRM(810.4,IND,100)),U) 95 .S VALMCNT=VALMCNT+1 96 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,LRNAME,LRCLASS) 97 .S IEN(VALMCNT)=IND 98 S RLIST("VALMCNT")=VALMCNT 99 Q 100 ; 101 LRADD ;Add Rule Option 102 ; 103 ;Reset Screen Mode 104 W IORESET 105 ; 106 ;Add Rule 107 D ADD^PXRMLRED 108 ; 109 ;Rebuild Workfile 110 D BLDLIST 111 S VALMBCK="R" 112 Q 113 ; 114 LRINQ ;Rule Inquiry - PXRM LIST RULE DISPLAY/EDIT entry 115 N IND,LRIEN,VALMY 116 D EN^VALM2(XQORNOD(0)) 117 ;If there is no list quit. 118 I '$D(VALMY) Q 119 S PXRMDONE=0 120 S IND="" 121 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 122 .;Get the ien. 123 .S LRIEN=^TMP("PXRMLRM",$J,"IDX",IND,IND) 124 .D START^PXRMLRED(LRIEN,PXRMTYP) 125 D BLDLIST 126 S VALMBCK="R" 127 Q 128 ; 129 PEXIT ;Protocol exit code 130 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 131 ;Reset after page up/down etc 132 D XQORM 133 Q 134 ; 135 VIEW ;Select view 136 W IORESET 137 S VALMBCK="R" 138 N X,Y,CODE,DIR 139 K DIROUT,DIRUT,DTOUT,DUOUT 140 S DIR(0)="S"_U_"F:Finding Rule;" 141 S DIR(0)=DIR(0)_"P:Patient List Rule;" 142 S DIR(0)=DIR(0)_"R:Reminder Rule;" 143 S DIR(0)=DIR(0)_"S:Rule Set;" 144 S DIR("A")="TYPE OF VIEW" 145 S DIR("B")="F" 146 S DIR("?")="Select from the codes displayed. For detailed help type ??" 147 S DIR("??")=U_"D HELP^PXRMLRM(2)" 148 D ^DIR K DIR 149 I $D(DIROUT) S DTOUT=1 150 I $D(DTOUT)!($D(DUOUT)) Q 151 ;Change display type 152 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,1:4) 153 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,Y="R":2,1:4) 154 ;Rebuild Workfile 155 D BLDLIST,HDR 156 Q 157 ; 158 XSEL ;PXRM LIST RULE MANAGEMENT SELECT ENTRY validation 159 N SEL,IEN 160 S SEL=$P(XQORNOD(0),"=",2) 161 ;Remove trailing , 162 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 163 ;Invalid selection 164 I SEL["," D Q 165 .W $C(7),!,"Only one item number allowed." H 2 166 .S VALMBCK="R" 167 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q 168 .W $C(7),!,SEL_" is not a valid item number." H 2 169 .S VALMBCK="R" 170 ; 171 ;Get the list ien. 172 S IEN=^TMP("PXRMLRM",$J,"IDX",SEL,SEL) 173 ; 174 ;Option to Display/Edit or Test Rule Set. 175 N DIR,OPTION,RIEN,X,Y 176 K DIROUT,DIRUT,DTOUT,DUOUT 177 S DIR(0)="SBM"_U_"DR:Display/Edit Rule;" 178 I $G(PXRMTYP)=3 S DIR(0)=DIR(0)_"TEST:Test Rule Set" 179 S DIR("A")="Select Action: " 180 S DIR("B")="DR" 181 S DIR("?")="Select from the codes displayed." 182 D ^DIR K DIR 183 I $D(DIROUT) S DTOUT=1 184 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q 185 S OPTION=Y 186 I $G(OPTION)="" G XSELE 187 ; 188 ;Display/Edit 189 I OPTION="DR" D START^PXRMLRED(IEN,PXRMTYP) 190 Q:$D(DUOUT)!$D(DTOUT) 191 ; 192 ;Rule set test 193 I OPTION="TEST" D RSTEST^PXRMRST(IEN) 194 Q:$D(DUOUT)!$D(DTOUT) 195 ; 196 XSELE ; 197 D CLEAN^VALM10 198 D BLDLIST,XQORM 199 S VALMBCK="R" 200 Q 201 ; 202 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM LIST RULE MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT 203 S XQORM("A")="Select Item: " 204 Q 205 ; 1 PXRMLRM ; SLC/PJH/PKR - List Rule Management ; 05/15/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Main entry point for PXRM LIST RULE MANAGEMENT 5 START N PXRMDONE,PXRMTYP,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 6 S X="IORESET" 7 D ENDR^%ZISS 8 S VALMCNT=0 9 ;Default view is Rule Sets 10 S PXRMTYP=3 11 D EN^VALM("PXRM LIST RULE MANAGEMENT") 12 Q 13 ; 14 BLDLIST ;Build workfile 15 K ^TMP("PXRMLRM",$J) 16 N IEN,IND,PLIST 17 D LIST(.PLIST,.IEN,PXRMTYP) 18 M ^TMP("PXRMLRM",$J)=PLIST 19 S VALMCNT=PLIST("VALMCNT") 20 F IND=1:1:VALMCNT D 21 .S ^TMP("PXRMLRM",$J,"IDX",IND,IND)=IEN(IND) 22 I PXRMTYP=1 D CHGCAP^VALM("HEADER2","Finding Rule Name") 23 I PXRMTYP=2 D CHGCAP^VALM("HEADER2","Reminder Rule Name") 24 I PXRMTYP=3 D CHGCAP^VALM("HEADER2","Rule Set Name") 25 I PXRMTYP=4 D CHGCAP^VALM("HEADER2","Report Output Rule Name") 26 I PXRMTYP=5 D CHGCAP^VALM("HEADER2","Patient List Rule Name") 27 Q 28 ; 29 ENTRY ;Entry code 30 D BLDLIST,XQORM 31 Q 32 ; 33 EXIT ;Exit code 34 K ^TMP("PXRMLRM",$J) 35 K ^TMP("PXRMLRMH",$J) 36 D CLEAN^VALM10 37 D FULL^VALM1 38 S VALMBCK="Q" 39 Q 40 ; 41 FRE(NUMBER,NAME,CLASS) ;Format entry number, name 42 ;and date packed. 43 N TCLASS,TEMP,TNAME,TSOURCE 44 S TEMP=$$RJ^XLFSTR(NUMBER,5," ") 45 S TNAME=$E(NAME,1,60) 46 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ") 47 S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL") 48 S TEMP=TEMP_" "_TCLASS 49 Q TEMP 50 ; 51 HDR ; Header code 52 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 53 Q 54 ; 55 HELP(CALL) ;General help text routine 56 N HTEXT 57 I CALL=1 D 58 .S HTEXT(1)="Select DE to display or edit a rule." 59 .S HTEXT(2)="Select ED to edit a rule" 60 ; 61 I CALL=2 D 62 .S HTEXT(1)=" Select F to edit term based finding rules." 63 .S HTEXT(2)=" Select P to edit patient list based finding rules." 64 .S HTEXT(3)=" Select R to edit reminder rules." 65 .S HTEXT(4)=" Select S to edit rule sets. A rule set may contain either " 66 .S HTEXT(5)="finding list rules or patient list rules or both. These " 67 .S HTEXT(6)="component list rules must be created before the rule set " 68 .S HTEXT(7)="can be constructed." 69 ; 70 D HELP^PXRMEUT(.HTEXT) 71 Q 72 ; 73 HLP ;Help code 74 N ORU,ORUPRMT,SUB,XQORM 75 S SUB="PXRMLRMH" 76 D EN^VALM("PXRM LIST RULE HELP") 77 Q 78 ; 79 INIT ;Init 80 S VALMCNT=0 81 Q 82 ; 83 LIST(RLIST,IEN,LRTYP) ;Build a list of list rule entries. 84 N DATA,IND,LRCLASS,LRNAME,NAME 85 ;Build the list in alphabetical order. 86 S VALMCNT=0 87 S NAME="" 88 F S NAME=$O(^PXRM(810.4,"B",NAME)) Q:NAME="" D 89 .S IND=$O(^PXRM(810.4,"B",NAME,"")) Q:'IND 90 .S DATA=$G(^PXRM(810.4,IND,0)) 91 .I $P(DATA,U,3)'=LRTYP Q 92 .S LRNAME=$P(DATA,U) 93 .S LRCLASS=$P($G(^PXRM(810.4,IND,100)),U) 94 .S VALMCNT=VALMCNT+1 95 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,LRNAME,LRCLASS) 96 .S IEN(VALMCNT)=IND 97 S RLIST("VALMCNT")=VALMCNT 98 Q 99 ; 100 LRADD ;Add Rule Option 101 ; 102 ;Reset Screen Mode 103 W IORESET 104 ; 105 ;Add Rule 106 D ADD^PXRMLRED 107 ; 108 ;Rebuild Workfile 109 D BLDLIST 110 S VALMBCK="R" 111 Q 112 ; 113 LRINQ ;Rule Inquiry - PXRM LIST RULE DISPLAY/EDIT entry 114 N IND,LRIEN,VALMY 115 D EN^VALM2(XQORNOD(0)) 116 ;If there is no list quit. 117 I '$D(VALMY) Q 118 S PXRMDONE=0 119 S IND="" 120 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D 121 .;Get the ien. 122 .S LRIEN=^TMP("PXRMLRM",$J,"IDX",IND,IND) 123 .D START^PXRMLRED(LRIEN,PXRMTYP) 124 D BLDLIST 125 S VALMBCK="R" 126 Q 127 ; 128 PEXIT ;Protocol exit code 129 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 130 ;Reset after page up/down etc 131 D XQORM 132 Q 133 ; 134 VIEW ;Select view 135 W IORESET 136 S VALMBCK="R" 137 N X,Y,CODE,DIR 138 K DIROUT,DIRUT,DTOUT,DUOUT 139 S DIR(0)="S"_U_"F:Finding Rule;" 140 S DIR(0)=DIR(0)_"P:Patient List Rule;" 141 S DIR(0)=DIR(0)_"R:Reminder Rule;" 142 S DIR(0)=DIR(0)_"S:Rule Set;" 143 S DIR("A")="TYPE OF VIEW" 144 S DIR("B")="F" 145 S DIR("?")="Select from the codes displayed. For detailed help type ??" 146 S DIR("??")=U_"D HELP^PXRMLRM(2)" 147 D ^DIR K DIR 148 I $D(DIROUT) S DTOUT=1 149 I $D(DTOUT)!($D(DUOUT)) Q 150 ;Change display type 151 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,1:4) 152 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,Y="R":2,1:4) 153 ;Rebuild Workfile 154 D BLDLIST,HDR 155 Q 156 ; 157 XSEL ;PXRM LIST RULE MANAGEMENT SELECT ENTRY validation 158 N SEL,IEN 159 S SEL=$P(XQORNOD(0),"=",2) 160 ;Remove trailing , 161 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1) 162 ;Invalid selection 163 I SEL["," D Q 164 .W $C(7),!,"Only one item number allowed." H 2 165 .S VALMBCK="R" 166 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q 167 .W $C(7),!,SEL_" is not a valid item number." H 2 168 .S VALMBCK="R" 169 ; 170 ;Get the list ien. 171 S IEN=^TMP("PXRMLRM",$J,"IDX",SEL,SEL) 172 ; 173 ;Option to Display/Edit or Test Rule Set. 174 N DIR,OPTION,RIEN,X,Y 175 K DIROUT,DIRUT,DTOUT,DUOUT 176 S DIR(0)="SBM"_U_"DR:Display/Edit Rule;" 177 I $G(PXRMTYP)=3 S DIR(0)=DIR(0)_"TEST:Test Rule Set" 178 S DIR("A")="Select Action: " 179 S DIR("B")="DR" 180 S DIR("?")="Select from the codes displayed." 181 D ^DIR K DIR 182 I $D(DIROUT) S DTOUT=1 183 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q 184 S OPTION=Y 185 I $G(OPTION)="" G XSELE 186 ; 187 ;Display/Edit 188 I OPTION="DR" D START^PXRMLRED(IEN,PXRMTYP) 189 Q:$D(DUOUT)!$D(DTOUT) 190 ; 191 ;Rule set test 192 I OPTION="TEST" D RSTEST^PXRMRST(IEN) 193 Q:$D(DUOUT)!$D(DTOUT) 194 ; 195 XSELE ; 196 D CLEAN^VALM10 197 D BLDLIST,XQORM 198 S VALMBCK="R" 199 Q 200 ; 201 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM LIST RULE MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT 202 S XQORM("A")="Select Item: " 203 Q 204 ;
Note:
See TracChangeset
for help on using the changeset viewer.
