Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG5.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/PXRMDLG5.m
r613 r623 1 PXRMDLG5 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;11/08/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ; 5 ;Display branching logic text in dialog summary view 6 N DATA,DNAM,DTYP,IEN,TERM,TNAME,TSTAT,TEMP 7 S DATA=$G(^PXRMD(801.41,DIEN,49)) 8 I '+$P(DATA,U)!($P($G(DATA),U,2)="") Q 9 S TNAME=$P($G(^PXRMD(811.5,$P(DATA,U),0)),U) 10 S TSTAT=$S($P(DATA,U,2)="1":"TRUE",1:"FALSE") 11 I +$P(DATA,U,3)>0 D 12 .S IEN=$P(DATA,U,3),DNAM=$P($G(^PXRMD(801.41,IEN,0)),U) 13 .S DTYP=$S($P($G(^PXRMD(801.41,IEN,0)),U,4)="E":"Element",$P($G(^PXRMD(801.41,IEN,0)),U,4)="G":"Group") 14 I $G(DNAM)="" S TEMP="Suppressed if Reminder Term "_TNAME_" evaluates as "_TSTAT 15 I $G(DNAM)'="" S TEMP="Replaced by "_DNAM_" if Reminder Term "_TNAME_" evaluates as "_TSTAT 16 D TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE) 17 Q 18 ; 19 ASK(YESNO,PIEN) ;Confirm 20 K DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y 21 N DDATA,DNAME,DTYP 22 S DDATA=$G(^PXRMD(801.41,PIEN,0)) 23 ;Parent name and type 24 S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) 25 ; 26 S DIR(0)="YA0" 27 S DIR("A")="Add sequence "_SEQ_" to " 28 I DTYP="G" S DIR("A")=DIR("A")_"group "_DNAME_": " 29 E S DIR("A")=DIR("A")_"reminder dialog ?: " 30 S DIR("B")="N",DIR("?")="Enter Y or N. For detailed help type ??" 31 S DIR("??")=U_"D XHLP^PXRMDLG(1)" 32 D ^DIR K DIR 33 I $D(DIROUT) S DTOUT=1 34 I $D(DTOUT)!($D(DUOUT)) Q 35 S YESNO=$E(Y(0)) I YESNO'="Y" S DUOUT=1 36 S VALMBCK="R" 37 Q 38 ; 39 BHELP(VALUE) ; 40 N HTEXT 41 D FULL^VALM1 42 ;Help text for Reminder Dialog Branching logic 43 I VALUE=1 D 44 .;Reminder Term field 45 .S HTEXT(1)="Enter a reminder term that will be used to determine if the reminder" 46 .S HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation" 47 .S HTEXT(3)="matches the value in the Reminder Term Status field." 48 I VALUE=2 D 49 .;Reminder Term Status field 50 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the" 51 .S HTEXT(2)="reminder term field to determine if this item should be replaced with a" 52 .S HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if" 53 .S HTEXT(4)="this item should be suppressed." 54 I VALUE=3 D 55 .;Replacement Element/Group field 56 .S HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or" 57 .S HTEXT(2)="leave this field blank to suppress this item if the term evaluation" 58 .S HTEXT(3)="matches the value defined in the term status field. " 59 I VALUE=4 D 60 .;Patient Specific field 61 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set to true" 62 .S HTEXT(2)="if item in this dialog will be using reminder term to either replace an item" 63 .S HTEXT(3)="or to suppress an item." 64 D HELP^PXRMEUT(.HTEXT) 65 Q 66 ; 67 INQ(DIEN) ;INQ Inquiry/Print option 68 ; Used by 801.41 print templates 69 ; [PXRM REMINDER DIALOG] 70 ; [PXRM DIALOG GROUP] 71 ; 72 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2) 73 N NLINE,NODE,NSEL,SUB 74 S NLINE=0,NODE="PXRMDLG4",NSEL=0 75 K ^TMP(NODE,$J) 76 ; 77 ;Components 78 W !!," Seq. Dialog",! 79 D DETAIL^PXRMDLG4(DIEN,"",4,NODE) 80 ; 81 ;Print lines from workfile 82 S SUB="" 83 F S SUB=$O(^TMP(NODE,$J,SUB)) Q:'SUB W !,^TMP(NODE,$J,SUB,0) 84 K ^TMP(NODE,$J) 85 Q 86 ; 87 MH(IEN) ;Allow IEN=109 (HX2) as a place holder for 601 entries that do not 88 ;have a corresponding 601.71 entry. 89 I IEN=109 Q 1 90 I $G(PXRMINST)=1 Q 1 91 N MAXNUM 92 S MAXNUM=+$P($G(^PXRM(800,1,"MH")),U) 93 I MAXNUM=0 S MAXNUM=25 94 Q $$ONECR^YTQPXRM5(IEN,MAXNUM) 95 ; 96 MHLICR(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template 97 ;branching works. 98 N Y 99 ;DBIA #5042 100 I $$RL^YTQPXRM3(IEN)="Y" D 101 .W !,"This MH test requires a license." 102 .W !,"The question text will not appear in the progress note.",! 103 .H 1 104 Q 105 ; 106 MSEL(NUM) ; 107 I NUM=4,'$$PATCH^XPDUTL("OR*3.0*243") D EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED") Q 0 108 Q 1 109 ; 110 MHREQHLP ; 111 N TEXT 112 S TEXT(1)="Select 0, ""Optional open and optional complete (partial complete possible)""," 113 S TEXT(2)="if the user should be able to optionally select/open the MH test in the reminder dialog and optionally complete the MH test before the reminder dialog can be finished." 114 S TEXT(3)=" " 115 S TEXT(4)="Select 1, ""Required open and required complete before finish""," 116 S TEXT(5)="if the user is required to select/open and complete the MH test in the reminder dialog before the reminder dialog can be finished." 117 S TEXT(6)=" " 118 S TEXT(7)="Select 2, ""Optional open and required complete or cancel before finish""," 119 S TEXT(8)="if the user should be able to optionally select/open the MH test in the reminder dialog; however, if the user opens the MH test, then the user is required to complete or cancel the MH test before the reminder dialog can be finished." 120 S TEXT(9)=" " 121 S TEXT(10)="Note: Clicking the cancel button in the MH Test is considered the same as not opening the MH Test." 122 S TEXT(11)="Also, Option 2, ""Optional open and required complete or cancel before finish"", only works with CPRS 27 and" 123 S TEXT(12)="YS_MHA.dll. If Option 2 is selected and the user is using a pre-CPRS 27 version this option will be treated by CPRS as Option 1, ""Required open and required complete before finish""." 124 D HELP^PXRMEUT(.TEXT) 125 Q 126 ; 127 NTERM(DA,OTERM,NTERM) ; 128 I +OTERM=0 S OTERM=$P($G(DA),U) 129 I +NTERM=0 K OTERM Q 2 130 I +OTERM=0,+NTERM>0 K OTERM Q 1 131 I +OTERM'=+NTERM K OTERM Q 0 132 K OTERM 133 Q 1 134 ; 135 OTERM(DA) ; 136 K OTERM 137 S OTERM=$P($G(^PXRMD(801.41,DA,49)),U) 138 Q 139 ; 140 RESCHK(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template 141 ;branching works. 142 N CNT,FDA,MSG,RG,RGIEN,VALID,Y 143 S CNT=0 144 F S CNT=$O(^PXRMD(801.41,IEN,51,CNT)) Q:CNT'>0 D 145 .S RGIEN=$P($G(^PXRMD(801.41,IEN,51,CNT,0)),U) I +RGIEN'>0 Q 146 .S RG=$P($G(^PXRMD(801.41,RGIEN,0)),U,1) 147 .I RG="" Q 148 .S VALID=$$RGLSCR(IEN,RG,RGIEN) 149 .I VALID Q 150 .W !,"Deleting the result group ",RG," from the element/group." 151 .S FDA(801.41121,CNT_","_IEN_",",.01)="@" 152 .D FILE^DIE("E","FDA","MSG") 153 .S RGKILL=1 154 .I $D(MSG) D AWRITE^PXRMUTIL("MSG") 155 Q 156 ; 157 RSELEDIT(DA) ; 158 N NODE,RESULT 159 ;RESULT=0 EDIT NOTHING 160 ;RESULT=1 EDIT INFORMATIONAL TEXT 161 ;RESULT=2 EDIT EVERYTHING 162 S RESULT=2 163 I $G(PXRMINST)=1,DUZ(0)="@" Q RESULT 164 S NODE=$G(^PXRMD(801.41,DA,100)) 165 I $P(NODE,U)="N" S RESULT=0 166 I RESULT=0,+$P(NODE,U,4)=0 S RESULT=1 167 Q RESULT 168 ; 169 RGLSCR(DA,X,IEN) ;Input transform/screen for RESULT GROUP LIST 170 I $G(PXRMINST)=1 Q 1 171 I $G(PXRMEXCH)=1 Q 1 172 N HELP,MHTEST,TEXT,VALID,Y 173 S NMATCH=0 174 S MHTEST=$O(^PXRMD(801.41,"B",X),-1) 175 F S MHTEST=$O(^PXRMD(801.41,"B",MHTEST)) Q:(NMATCH>1)!(MHTEST'[X) S NMATCH=NMATCH+1 176 ;If there is an exact match to the user's input turn help on. 177 S HELP=$S($G(DIQUIET):0,NMATCH=1:1,1:0) 178 S VALID=1 179 ;Make sure the TYPE is a result group 180 I '$D(^PXRMD(801.41,"TYPE","S",IEN)) D 181 . I HELP S TEXT(1)="TYPE must be a result group." 182 . S VALID=0 183 ;Make sure the finding item for the element matches the 184 ;MH Test assigned to the Result Group 185 S MHTEST=+$P($G(^PXRMD(801.41,DA,1)),U,5) I MHTEST="" D 186 . I HELP S TEXT(2)="The MH test is missing." 187 . S VALID=0 188 I +$P($G(^PXRMD(801.41,IEN,50)),U)'=MHTEST D 189 . I HELP S TEXT(3)="The finding item does not match the MH Test assigned to the Result Group" 190 . S VALID=0 191 ;Make sure a scale has been defined. 192 I +$P($G(^PXRMD(801.41,IEN,50)),U,2)'>0 D 193 . I HELP S TEXT(4)="An MH Scale must be defined." 194 . S VALID=0 195 ;Make sure it is not disabled. 196 I $P($G(^PXRMD(801.41,IEN,0)),U,3)'="" D 197 . S VALID=0 198 . I HELP D 199 .. N EM,TYPE 200 .. S TYPE=$P(^PXRMD(801.41,IEN,0),U,4) 201 .. S TYPE=$$EXTERNAL^DILFD(801.41,4,"",TYPE,.EM) 202 .. S TEXT(5)="The "_TYPE_" is disabled." 203 I HELP,'VALID D EN^DDIOL(.TEXT) 204 Q VALID 205 ; 206 TERMS(DA,X) ; 207 N TERM 208 S TERM=$P($G(^PXRMD(801.41,DA,49)),U) 209 I +TERM=0 D Q 0 210 .W !,"Cannot set Reminder Term Status if the Reminder Term field is blank" 211 .H 2 212 I +TERM>0,$G(X)="" Q 2 213 Q 1 214 ; 215 TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ; 216 N CNT1,NOUT,OUTPUT,WIDHT 217 S WIDTH=IOM-(2+(CNT+ATLEN)) 218 S CNT1=1 D FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT) 219 I NOUT>0 F CNT1=1:1:NOUT D 220 .S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",2+(CNT+ATLEN))_OUTPUT(CNT1) 221 Q 222 ; 1 PXRMDLG5 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;05/17/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ; 5 ASK(YESNO,PIEN) ;Confirm 6 K DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y 7 N DDATA,DNAME,DTYP 8 S DDATA=$G(^PXRMD(801.41,PIEN,0)) 9 ;Parent name and type 10 S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) 11 ; 12 S DIR(0)="YA0" 13 S DIR("A")="Add sequence "_SEQ_" to " 14 I DTYP="G" S DIR("A")=DIR("A")_"group "_DNAME_": " 15 E S DIR("A")=DIR("A")_"reminder dialog ?: " 16 S DIR("B")="N",DIR("?")="Enter Y or N. For detailed help type ??" 17 S DIR("??")=U_"D XHLP^PXRMDLG(1)" 18 D ^DIR K DIR 19 I $D(DIROUT) S DTOUT=1 20 I $D(DTOUT)!($D(DUOUT)) Q 21 S YESNO=$E(Y(0)) I YESNO'="Y" S DUOUT=1 22 S VALMBCK="R" 23 Q 24 ; 25 MSEL(NUM) ; 26 I NUM=4,'$$PATCH^XPDUTL("OR*3.0*243") D EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED") Q 0 27 Q 1 28 ; 29 ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ; 30 ;Display branching logic text in dialog summary view 31 N DATA,DNAM,DTYP,IEN,TERM,TNAME,TSTAT,TEMP 32 S DATA=$G(^PXRMD(801.41,DIEN,49)) 33 I '+$P(DATA,U)!($P($G(DATA),U,2)="") Q 34 S TNAME=$P($G(^PXRMD(811.5,$P(DATA,U),0)),U) 35 S TSTAT=$S($P(DATA,U,2)="1":"TRUE",1:"FALSE") 36 I +$P(DATA,U,3)>0 D 37 .S IEN=$P(DATA,U,3),DNAM=$P($G(^PXRMD(801.41,IEN,0)),U) 38 .S DTYP=$S($P($G(^PXRMD(801.41,IEN,0)),U,4)="E":"Element",$P($G(^PXRMD(801.41,IEN,0)),U,4)="G":"Group") 39 I $G(DNAM)="" S TEMP="Suppressed if Reminder Term "_TNAME_" evaluates as "_TSTAT 40 I $G(DNAM)'="" S TEMP="Replaced by "_DNAM_" if Reminder Term "_TNAME_" evaluates as "_TSTAT 41 D TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE) 42 Q 43 ; 44 OTERM(DA) ; 45 K OTERM 46 S OTERM=$P($G(^PXRMD(801.41,DA,49)),U) Q 47 ; 48 NTERM(DA,OTERM,NTERM) ; 49 I +OTERM=0 S OTERM=$P($G(DA),U) 50 I +NTERM=0 K OTERM Q 2 51 I +OTERM=0,+NTERM>0 K OTERM Q 1 52 I +OTERM'=+NTERM K OTERM Q 0 53 K OTERM 54 Q 1 55 ; 56 TERMS(DA,X) ; 57 N TERM 58 S TERM=$P($G(^PXRMD(801.41,DA,49)),U) 59 I +TERM=0 D Q 0 60 .W !,"Cannot set Reminder Term Status if the Reminder Term field is blank" 61 .H 2 62 I +TERM>0,$G(X)="" Q 2 63 Q 1 64 ; 65 BHELP(VALUE) ; 66 N HTEXT 67 D FULL^VALM1 68 ;Help text for Reminder Dialog Branching logic 69 I VALUE=1 D 70 .;Reminder Term field 71 .S HTEXT(1)="Enter a reminder term that will be used to determine if the reminder" 72 .S HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation" 73 .S HTEXT(3)="matches the value in the Reminder Term Status field." 74 I VALUE=2 D 75 .;Reminder Term Status field 76 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the" 77 .S HTEXT(2)="reminder term field to determine if this item should be replaced with a" 78 .S HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if" 79 .S HTEXT(4)="this item should be suppressed." 80 I VALUE=3 D 81 .;Replacement Element/Group field 82 .S HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or" 83 .S HTEXT(2)="leave this field blank to suppress this item if the term evaluation" 84 .S HTEXT(3)="matches the value defined in the term status field. " 85 I VALUE=4 D 86 .;Patient Specific field 87 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set totrue" 88 .S HTEXT(2)="if item in this dialog will be using reminder term to either replace an item" 89 .S HTEXT(3)="or to suppress an item." 90 D HELP^PXRMEUT(.HTEXT) 91 Q 92 ; 93 TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ; 94 N CNT1,NOUT,OUTPUT,WIDHT 95 S WIDTH=IOM-(2+(CNT+ATLEN)) 96 S CNT1=1 D FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT) 97 I NOUT>0 F CNT1=1:1:NOUT D 98 .S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",2+(CNT+ATLEN))_OUTPUT(CNT1) 99 Q 100 ; 101 INQ(DIEN) ;INQ Inquiry/Print option 102 ; 103 ; Used by 801.41 print templates 104 ; [PXRM REMINDER DIALOG] 105 ; [PXRM DIALOG GROUP] 106 ; 107 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2) 108 N NLINE,NODE,NSEL,SUB 109 S NLINE=0,NODE="PXRMDLG4",NSEL=0 110 K ^TMP(NODE,$J) 111 ; 112 ;Components 113 W !!," Seq. Dialog",! 114 D DETAIL^PXRMDLG4(DIEN,"",4,NODE) 115 ; 116 ;Print lines from workfile 117 S SUB="" 118 F S SUB=$O(^TMP(NODE,$J,SUB)) Q:'SUB W !,^TMP(NODE,$J,SUB,0) 119 K ^TMP(NODE,$J) 120 Q
Note:
See TracChangeset
for help on using the changeset viewer.
