source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSEL2.m@ 1379

Last change on this file since 1379 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PXRMSEL2 ; 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 ;-------------------------------------------
8START 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 ;---------------------
23ASK(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 ;---------------------------------------------
39OPT(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 ;------------------
56REM(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 ;---------------------
87SEL(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 ;------------------------
118SKIP 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 ;--------------------------
141HELP(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
Note: See TracBrowser for help on using the repository browser.