source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP6I.m@ 975

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

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1PXRMP6I ; SLC/PKR - Inits for PXRM*2.0*6 ;11/25/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 Q
4 ;====================================================
5DELDD ;Delete the old data dictionaries.
6 N DIU,TEXT
7 D EN^DDIOL("Removing old data dictionaries.")
8 S DIU(0)=""
9 F DIU=800,801.41,810.1,810.2,810.4,810.5,810.8,811.5,811.8,811.9 D
10 . S TEXT=" Deleting data dictionary for file # "_DIU
11 . D EN^DDIOL(TEXT)
12 . D EN^DIU2
13 Q
14 ;
15 ;====================================================
16LISTRULE(IEN) ;List of list rules to include in the build.
17 N NAME,OK
18 S OK=0
19 S NAME=$P(^PXRM(810.4,IEN,0),U,1)
20 I NAME="VA-*IHD QUERI 412 DIAGNOSIS" S OK=1
21 I NAME="VA-*IHD QUERI ANCHOR VISIT" S OK=1
22 I NAME="VA-*IHD QUERI LIPID LOWERING MEDS" S OK=1
23 I NAME="VA-*IHD QUERI PTS WITH QUALIFY VISIT" S OK=1
24 I NAME="VA-*MH QUERI QUALIFY MH VISIT" S OK=1
25 I NAME="VA-*MH QUERI QUALIFY PC VISIT" S OK=1
26 I OK D RMEHIST^PXRMUTIL(810.4,IEN)
27 Q OK
28 ;
29 ;====================================================
30OPTION(ACTION) ;Disable/enable options.
31 N ACT,IND,OPT,LIST,RESULT
32 S ACT=$S(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
33 D BMES^XPDUTL(ACT_" options.")
34 ;
35 D FIND^DIC(19,"","@;.01","","GMTS","*","B","","","LIST")
36 F IND=1:1:+LIST("DILIST",0) D
37 . S OPT=LIST("DILIST","ID",IND,.01)
38 S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
39 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
40 ;
41 K LIST
42 D FIND^DIC(19,"","@;.01","","IBDF PRINT","*","B","","","LIST")
43 F IND=1:1:+LIST("DILIST",0) D
44 . S OPT=LIST("DILIST","ID",IND,.01)
45 . S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
46 . I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
47 ;
48 S OPT="OR CPRS GUI CHART"
49 S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
50 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
51 ;
52 S OPT="ORS HEALTH SUMMARY"
53 S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
54 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" option "_OPT)
55 ;
56 K LIST
57 D FIND^DIC(19,"","@;.01","","PXRM","*","B","","","LIST")
58 F IND=1:1:+LIST("DILIST",0) D
59 . S OPT=LIST("DILIST","ID",IND,.01)
60 . S RESULT=$$OPTDE^XPDUTL(OPT,ACTION)
61 . I RESULT=0 W !,"Could not ",ACTION," option ",OPT
62 Q
63 ;
64 ;====================================================
65PRE ;These are the pre-installation actions
66 D ENVCHK^PXRMP6IM I $G(XPDABORT)=1 Q
67 ;Disable options and protocols
68 D OPTION(2)
69 D PROTOCOL(2)
70 ;Delete existing exchange file entries.
71 D DELEXI^PXRMP6IE
72 ;Rename entries that need it.
73 D RENAME
74 ;Initialize list template.
75 D INILT^PXRMP6IL
76 ;Delete the old DDs.
77 D DELDD
78 ;Repoint dialog with BDI as a finding item to BDI2
79 D BDICONV^PXRMP6ID
80 D CHECKRG^PXRMP6ID
81 D STORERG^PXRMP6ID
82 Q
83 ;
84 ;====================================================
85POST ;These are the post-installation actions
86 N NLINES
87 D SETMAXMH
88 ;Convert the mental health pointers.
89 D HMHPTRS^PXRMP6IM(.NLINES,1)
90 ;Convert Conditions for mental health findings.
91 D MHCOND^PXRMP6IC
92 I '$D(^PXRMINDX(601.84,"DATE BUILT")) S ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
93 ;Convert the rule set sequences to numbers.
94 D SEQCONV^PXRMP6IS
95 ;Enable options and protocols
96 D OPTION(1)
97 D PROTOCOL(1)
98 D SMEXINS^PXRMP6IE
99 D RTAXEXP
100 D WRITERG^PXRMP6ID
101 D DCLEAN^PXRMP6ID
102 D REINDEX^PXRMP6ID
103 D RESCIND
104 Q
105 ;
106 ;====================================================
107PROTOCOL(ACTION) ;Disable/enable protocols.
108 N ACT,PROT,RESULT
109 S ACT=$S(ACTION=2:"DISABLE",ACTION=1:"ENABLE",1:"?")
110 D BMES^XPDUTL(ACT_" protocols.")
111 ;
112 S PROT="ORS HEALTH SUMMARY"
113 S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
114 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
115 ;
116 S PROT="ORS AD HOC HEALTH SUMMARY"
117 S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
118 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
119 ;
120 S PROT="PXRM PATIENT DATA CHANGE"
121 S RESULT=$$PRODE^XPDUTL(PROT,ACTION)
122 I RESULT=0 D MES^XPDUTL("Could not "_ACT_" protocol "_PROT)
123 Q
124 ;
125 ;====================================================
126RESCIND ;
127 N ARY,NAME,IEN,TEXT
128 S TEXT(1)="Rescinding outdated National Reminder and disabling outdated"
129 S TEXT(2)="National Reminder Dialog"
130 S TEXT(3)=""
131 D BMES^XPDUTL(.TEXT)
132 S NAME="VA-POS DEPRESSION SCREEN FOLLOWUP"
133 S IEN=$O(^PXD(811.9,"B",NAME,"")) Q:IEN'>0
134 K ARY
135 ;S ARY(1,811.9,IEN_",",1.6)=1
136 S ARY(1,811.9,IEN_",",69)=3071101
137 D FILE^DIE("","ARY(1)")
138 S TEXT(1)="Rescinding reminder: "_NAME
139 S TEXT(2)=""
140 D BMES^XPDUTL(.TEXT)
141 S DIEN=$G(^PXD(811.9,IEN,51)) Q:DIEN'>0
142 S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
143 K ARY
144 S ARY(1,801.41,DIEN_",",3)="Disable with PXRM*2.0*6 on Nov 1, 2007"
145 D FILE^DIE("","ARY(1)")
146 S TEXT(1)="Disabling Dialog: "_NAME
147 D BMES^XPDUTL(.TEXT)
148 Q
149 ;====================================================
150RENAME ;Rename entries
151 N DA,DIE
152 S DA=+$O(^PXRM(810.4,"B","VA-*MH QUERY QUALIFYING MH VISIT",""))
153 I DA=0 Q
154 S DIE=810.4,DR=".01///VA-*MH QUERI QUALIFYING MH VISIT"
155 D ^DIE
156 Q
157 ;
158 ;====================================================
159RTAXEXP ;Rebuild taxonomy expansions.
160 N IEN,IND,TEXT,TNAME
161 S TNAME(1)="VA-TETANUS DIPHTHERIA"
162 S TNAME(2)="VA-WH HYSTERECTOMY W/CERVIX REMOVED"
163 D BMES^XPDUTL("Rebuilding taxonomy expansions.")
164 F IND=1:1:2 D
165 . S IEN=$O(^PXD(811.2,"B",TNAME(IND),""))
166 . I IEN="" Q
167 . S TEXT=" Working on taxonomy "_IEN
168 . D BMES^XPDUTL(TEXT)
169 . D DELEXTL^PXRMBXTL(IEN)
170 . D EXPAND^PXRMBXTL(IEN,"")
171 Q
172 ;
173 ;====================================================
174SETMAXMH ;Set the maximum number of mental health questions that can be
175 ;administered through a reminder dialog.
176 N DA,DIE,DR
177 I +$P($G(^PXRM(800,1,"MH")),U)>0 Q
178 S DA=1,DR="17////35",DIE="^PXRM(800," D ^DIE
179 Q
180 ;
Note: See TracBrowser for help on using the repository browser.