1 | PXRMSEL2 ; SLC/PJH - PXRM Selection ;04/16/2000
|
---|
2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
3 | ;
|
---|
4 | ; Called from PXRMSEL
|
---|
5 | ;
|
---|
6 | ;Select Health factors requiring resolutions
|
---|
7 | ;-------------------------------------------
|
---|
8 | START W IORESET
|
---|
9 | ;Select to edit individual or reminder's Health Factors
|
---|
10 | D OPT(.ANS) Q:$D(DTOUT)!$D(DUOUT) Q:ANS="I"
|
---|
11 | ;Select Reminder
|
---|
12 | S DIC("A")="SELECT REMINDER: "
|
---|
13 | S LIT1="You must select a reminder!"
|
---|
14 | D REM(.ARRAY) Q:$D(DTOUT)!$D(DUOUT)
|
---|
15 | ;Scan health factors
|
---|
16 | D SKIP
|
---|
17 | ;Rebuild listman screen
|
---|
18 | D INIT^PXRMSEL
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | ;Ask ADD/MODIFY or not
|
---|
22 | ;---------------------
|
---|
23 | ASK(YESNO,TEXT) ;
|
---|
24 | N X,Y,DIR
|
---|
25 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
26 | S DIR(0)="YA0"
|
---|
27 | S DIR("A")=TEXT
|
---|
28 | S DIR("B")="N"
|
---|
29 | S DIR("?")="Enter Y or N. For detailed help type ??"
|
---|
30 | S DIR("??")=U_"D ZHELP^PXRMSEL(2)"
|
---|
31 | D ^DIR K DIR
|
---|
32 | I $D(DIROUT) S DTOUT=1
|
---|
33 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
34 | S YESNO=$E(Y(0))
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | ;Select single HF or all HF's for the reminder
|
---|
38 | ;---------------------------------------------
|
---|
39 | OPT(TYPE) ;
|
---|
40 | N X,Y
|
---|
41 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
42 | S DIR(0)="S"_U_"I:Individual Health Factor;"
|
---|
43 | S DIR(0)=DIR(0)_"A:All Health Factors for a Selected Reminder;"
|
---|
44 | S DIR("A")="SELECTION OPTION"
|
---|
45 | S DIR("B")="I"
|
---|
46 | S DIR("?")="Select from the codes displayed. For detailed help type ??"
|
---|
47 | S DIR("??")=U_"D ZHELP^PXRMSEL(1)"
|
---|
48 | D ^DIR K DIR
|
---|
49 | I $D(DIROUT) S DTOUT=1
|
---|
50 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
51 | S TYPE=Y
|
---|
52 | Q
|
---|
53 | ;
|
---|
54 | ;Reminder selection
|
---|
55 | ;------------------
|
---|
56 | REM(ARRAY) ;
|
---|
57 | N X,Y,CNT,FSUB,FHF,FIND,FNAM,FOUND,REM
|
---|
58 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
59 | S FOUND=0
|
---|
60 | W !
|
---|
61 | F D Q:$D(DTOUT) Q:$D(DUOUT) Q:FOUND
|
---|
62 | .S DIC=811.9,DIC(0)="AEMQZ"
|
---|
63 | .D ^DIC K DIC S:X=(U_U) DTOUT=1 Q:$D(DTOUT)!$D(DUOUT)!(+Y=-1)
|
---|
64 | .;Reminder ien
|
---|
65 | .S REM=$P(Y,U) Q:'REM
|
---|
66 | .;Get health factor findings on this reminder
|
---|
67 | .S FSUB=0
|
---|
68 | .F S FSUB=$O(^PXD(811.9,REM,20,FSUB)) Q:'FSUB D
|
---|
69 | ..S FIND=$P($G(^PXD(811.9,REM,20,FSUB,0)),U)
|
---|
70 | ..Q:$P(FIND,";",2)'="AUTTHF("
|
---|
71 | ..S FHF=$P(FIND,";") Q:'FHF
|
---|
72 | ..S FNAM=$P($G(^AUTTHF(FHF,0)),U) Q:FNAM=""
|
---|
73 | ..;Save array used by PXRMGEDT
|
---|
74 | ..S FOUND=FOUND+1
|
---|
75 | ..S ARRAY(FNAM)=FHF,ARRAYN(FHF)=""
|
---|
76 | .I 'FOUND W !!,"No health factor findings on this reminder",! Q
|
---|
77 | .S FNAM=""
|
---|
78 | .W !!,"HEALTH FACTORS:",!
|
---|
79 | .F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D
|
---|
80 | ..S FHF=$P(ARRAY(FNAM),U)
|
---|
81 | ..W !,FNAM W:$D(^PXRMD(801.95,FHF,0)) " (Resolution defined)"
|
---|
82 | .W !
|
---|
83 | Q
|
---|
84 | ;
|
---|
85 | ;Dialog type selection
|
---|
86 | ;---------------------
|
---|
87 | SEL(TYPE) ;
|
---|
88 | W IORESET
|
---|
89 | N X,Y,DIR
|
---|
90 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
91 | S DIR(0)="S"_U_"D:Reminder Dialogs;"
|
---|
92 | S DIR(0)=DIR(0)_"E:Dialog Elements;"
|
---|
93 | S DIR(0)=DIR(0)_"F:Forced Values;"
|
---|
94 | S DIR(0)=DIR(0)_"G:Dialog Groups;"
|
---|
95 | S DIR(0)=DIR(0)_"P:Additional Prompts;"
|
---|
96 | S DIR(0)=DIR(0)_"R:Reminders;"
|
---|
97 | S DIR(0)=DIR(0)_"RG:Result Group (Mental Health);"
|
---|
98 | S DIR(0)=DIR(0)_"RE:Result Element (Mental Health);"
|
---|
99 | S DIR("A")="TYPE OF VIEW"
|
---|
100 | S DIR("B")="R"
|
---|
101 | S DIR("?")="Select from the codes displayed. For detailed help type ??"
|
---|
102 | S DIR("??")=U_"D HELP^PXRMSEL2(3)"
|
---|
103 | D ^DIR K DIR
|
---|
104 | I $D(DIROUT) S DTOUT=1
|
---|
105 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
106 | S TYPE=Y
|
---|
107 | ;Change display type
|
---|
108 | S PXRMGTYP=$S(TYPE="D":"DLG",TYPE="R":"DLGR",1:"DLGE")
|
---|
109 | I TYPE'="R" D
|
---|
110 | .I TYPE="D" S PXRMDTYP="R" Q
|
---|
111 | .I TYPE="RG" S PXRMDTYP="S" Q
|
---|
112 | .I TYPE="RE" S PXRMDTYP="T" Q
|
---|
113 | .S PXRMDTYP=TYPE
|
---|
114 | Q
|
---|
115 | ;
|
---|
116 | ;Reminders Health Factors
|
---|
117 | ;------------------------
|
---|
118 | SKIP N ANS,FNAM,FHF,EXISTS,TEXT
|
---|
119 | S FNAM=""
|
---|
120 | F S FNAM=$O(ARRAY(FNAM)) Q:FNAM="" D Q:$D(DUOUT)!$D(DTOUT)
|
---|
121 | .S FHF=ARRAY(FNAM),EXISTS=$D(^PXRMD(801.95,FHF,0))
|
---|
122 | .I 'EXISTS S TEXT="ADD resolution status for "_FNAM_": "
|
---|
123 | .I EXISTS S TEXT="MODIFY resolution status for "_FNAM_": "
|
---|
124 | .;Option to ADD/MODIFY
|
---|
125 | .D ASK(.ANS,TEXT) Q:$D(DTOUT)!$D(DUOUT) Q:(ANS'="Y")
|
---|
126 | .;Force entry of HF into 801.95
|
---|
127 | .I 'EXISTS D
|
---|
128 | ..N DA,DIC,DIK,DR
|
---|
129 | ..;Store the unique name
|
---|
130 | ..S DR=".01///"_FNAM,DIE="^PXRMD(801.95,",DA=FHF
|
---|
131 | ..D ^DIE
|
---|
132 | ..;Reindex the cross-references.
|
---|
133 | ..S DIK="^PXRMD(801.95,",DA=FHF
|
---|
134 | ..D IX^DIK
|
---|
135 | .;Edit
|
---|
136 | .D EDIT^PXRMGEDT(PXRMGTYP,FHF,1)
|
---|
137 | Q
|
---|
138 | ;
|
---|
139 | ;General help text routine.
|
---|
140 | ;--------------------------
|
---|
141 | HELP(CALL) ;
|
---|
142 | N HTEXT
|
---|
143 | N DIWF,DIWL,DIWR,IC
|
---|
144 | S DIWF="C75",DIWL=0,DIWR=75
|
---|
145 | ;
|
---|
146 | I CALL=1 D
|
---|
147 | .S HTEXT(1)="Enter I to select an individual health factor. Enter A to"
|
---|
148 | .S HTEXT(2)="process all health factor findings on a selected reminder."
|
---|
149 | I CALL=2 D
|
---|
150 | .S HTEXT(1)="Enter Yes to enter resolution status for this health"
|
---|
151 | .S HTEXT(2)="factor. Enter No to continue to the next health factor."
|
---|
152 | I CALL=3 D
|
---|
153 | .S HTEXT(1)="Select the type of view to be displayed. You may view"
|
---|
154 | .S HTEXT(2)="either reminders or selected dialog types."
|
---|
155 | K ^UTILITY($J,"W")
|
---|
156 | S IC=""
|
---|
157 | F S IC=$O(HTEXT(IC)) Q:IC="" D
|
---|
158 | . S X=HTEXT(IC)
|
---|
159 | . D ^DIWP
|
---|
160 | W !
|
---|
161 | S IC=0
|
---|
162 | F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
|
---|
163 | . W !,^UTILITY($J,"W",0,IC,0)
|
---|
164 | K ^UTILITY($J,"W")
|
---|
165 | W !
|
---|
166 | Q
|
---|