source: qrda/C0Q/trunk/p/C0QKIDS.m@ 1751

Last change on this file since 1751 was 1501, checked in by Sam Habiel, 12 years ago

Latest routines; T11 copy
File size: 9.4 KB
Line 
1C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/31/12 3:01pm
2 ;;1.0;C0Q;;May 21, 2012;Build 63
3 ; Licensed under package license. See Documentation.
4 ;
5 ; PEPs: TRAN, POST, PRE
6 ;
7TRAN ; Unified Transport; PEP
8 ; D TRAN301 ; looks like I won't send that file over
9 D TRAN201 ; C0Q MEASUREMENT
10 D TRAN101 ; C0Q QUALITY MEASURE
11 QUIT
12POST ; Unified Post; PEP
13 ; D POST301 ; looks like I won't send that file over
14 ; D POST101 ; C0Q QUALITY MEASURE ; As of T11, I won't do that anymore. -->
15 ; I discovered that it will do it on destination systems that are set-up.
16 ; So bad bad bad idea for me to do it in a post-init.
17 ; ... I wrote TRAN101 to do the function of POST101.
18 D POST201 ; C0Q MEASUREMENT
19 QUIT
20 ;
21PRE ; Unified Pre; PEP
22 D PRE101
23 QUIT
24 ;
25 ; << >>
26 ;
27TRAN101 ; Remove Untransportable pointers in C0Q QUALITY MEASURE; Private EP
28 ; NB: I am reaching into KIDS's data here. This may not work for future versions
29 ; of KIDS. However, I am exporting this only; once exported, it should work in
30 ; any version of KIDS.
31 N XPDIEN S XPDIEN=$QS(XPDGREF,2) ; Get IEN of KIDS Transport Global
32 N X S X=$NA(^XTMP("XPDT",XPDIEN,"DATA",1130580001.101)) ; KIDS transports our data here
33 N IEN S IEN=0 ; Looper
34 F S IEN=$O(@X@(IEN)) Q:'IEN D ; For each IEN, remove the following:
35 . S $P(@X@(IEN,0),U,2)="" ; Numerator Patient List
36 . S $P(@X@(IEN,0),U,3)="" ; Denominator Patient List
37 . S $P(@X@(IEN,7),U,4)="" ; Negative Numerator List
38 . S $P(@X@(IEN,7),U,2)="" ; Alternate Numerator List
39 . S $P(@X@(IEN,7),U,3)="" ; Alternate Denominator List
40 . S $P(@X@(IEN,7),U,5)="" ; Alternate Negative Numerator List
41 QUIT
42 ;
43TRAN301 ; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP
44 ; Not used. Dead code.
45 N C0QIEN S C0QIEN=0 ; IEN walker
46 N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
47 N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
48 K @C0QREF1,@C0QREF2 ; Kill that
49 F S C0QIEN=$O(^C0Q(301,C0QIEN)) Q:'+C0QIEN D
50 . D GETS^DIQ(1130580001.301,C0QIEN_",","*","",C0QREF1) ; Load FDA's in there
51 . M @C0QREF2@(1130580001.301,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.301,C0QIEN_",") ; Change IENs to ?+ IENs
52 M @XPDGREF@("C0Q","1130580001.301")=@C0QREF2 ; Put in Transport Global
53 K @C0QREF1,@C0QREF2 ; Remove
54 QUIT
55 ;
56TRAN201 ; Grab FDA for 201 C0Q MEASUREMENTS selected fields; Private EP
57 N C0QIEN S C0QIEN=0 ; IEN walker
58 N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
59 N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
60 K @C0QREF1,@C0QREF2 ; Kill that
61 ;
62 ; We need C0QCOUNT so that it wouldn't reuse the numbers, b/c updater wants numbers for every different item
63 N C0QCOUNT S C0QCOUNT=$O(^C0Q(201," "),-1) ; Counter for SubIENs for destination array; init at highest IEN to prevent dups
64 F S C0QIEN=$O(^C0Q(201,C0QIEN)) Q:'+C0QIEN D ; Walk IENs
65 . W "Exporting "_C0QIEN,!
66 . ; Fields SET NAME, BEGIN DATE, END DATE, LOCKED, USE ALL MEASURES, MU YEAR KEY
67 . D GETS^DIQ(1130580001.201,C0QIEN_",",".01;.02;.03;.05;.2;.3","",C0QREF1)
68 . M @C0QREF2@(1130580001.201,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.201,C0QIEN_",") ; Change IENs to ?+ IENs
69 . N C0QIEN2 S C0QIEN2=0 ; Subfile walker
70 . F S C0QIEN2=$O(^C0Q(201,C0QIEN,5,C0QIEN2)) Q:'+C0QIEN2 D ; MEASURE subfile
71 . . W "Exporting IENS "_C0QIEN2_","_C0QIEN_",",!
72 . . D GETS^DIQ(1130580001.2011,C0QIEN2_","_C0QIEN_",",".01","",C0QREF1) ; MEASURE (#.01)
73 . . S C0QCOUNT=C0QCOUNT+1 ; Increment the counter for SubIEN (can't reuse)
74 . . M @C0QREF2@(1130580001.2011,"?+"_C0QCOUNT_","_"?+"_C0QIEN_",")=@C0QREF1@(1130580001.2011,C0QIEN2_","_C0QIEN_",") ; as above
75 ;
76 M @XPDGREF@("C0Q","1130580001.201")=@C0QREF2 ; Put in transport global
77 K @C0QREF1,@C0QREF2 ; Remove temp
78 QUIT
79 ;
80POST201 ; File FDA for 201; Private EP
81 ;
82 ; Clean-up data if it already exists!
83 ; ZWRITE ^C0Q(201,:,5,:,0)
84 ; ^C0Q(201,1,5,599,0)=50
85 ; ^C0Q(201,1,5,600,0)=4
86 ; ^C0Q(201,1,5,601,0)=39
87 ; ^C0Q(201,1,5,602,0)=6
88 ; ^C0Q(201,1,5,603,0)=7
89 ; ^C0Q(201,1,5,604,0)=48
90 ; ^C0Q(201,1,5,605,0)=46
91 ;
92 IF $O(^C0Q(201,0)) DO QUIT ; Quit if data is already there.
93 . D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data")
94 . D MES^XPDUTL("Cleaning up broken pointers in C0Q MEASUREMENTS from deleted data in C0Q QUALITY MEASURE")
95 . ; This is very hairy code. Run through the 5 multiple in C0Q MEASUREMENT
96 . ; Grab the IEN in the .01, check if it exists; if not, kill.
97 . N DA,DIK ; DIK Variables; as well as our looper variables
98 . S (DA,DA(1))=0 ; Initial looper values
99 . F S DA(1)=$O(^C0Q(201,DA(1))) Q:'DA(1) D ; Loop through entries
100 . . D MES^XPDUTL("...Processing entry "_$P(^C0Q(201,DA(1),0),U)) ; msg
101 . . S DIK="^C0Q(201,"_DA(1)_",5," ; deletion root for the next loop
102 . . F S DA=$O(^C0Q(201,DA(1),5,DA)) Q:'DA D ; For each Measure
103 . . . N IEN S IEN=+^C0Q(201,DA(1),5,DA,0) ; Get IEN
104 . . . I IEN,'$D(^C0Q(101,IEN)) D ; If IEN is numeric, IEN exists in dest file
105 . . . . D MES^XPDUTL("......Deleting broken pointer "_IEN) ; msg
106 . . . . D ^DIK ; delete
107 ;
108 ; If new install, add data
109 ;
110 D MES^XPDUTL("Adding data to C0Q MEASUREMENTS")
111 N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.201")) ; Grab FDA from Transport Global
112 N C0QERR ; Error array for filer
113 D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
114 I $D(C0QERR) D ; if there's an error, print it out
115 . D MES^XPDUTL("Couldn't add data into C0Q MEASUREMENTS")
116 . S C0QERR=$Q(C0QERR)
117 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR)
118 QUIT
119 ;
120POST301 ; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP
121 ; Not used. Dead code.
122 N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference
123 N C0QERR ; Error
124 D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
125 I $D(C0QERR) D ; if there's an error, print it out
126 . D MES^XPDUTL("Couldn't add data into C0Q PATIENT LIST file")
127 . S C0QERR=$Q(C0QERR)
128 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR)
129 QUIT
130 ;
131PRE101 ; Clean existing data (from an earlier installation) from measures that are now merged to other measures
132 ; in C0Q QUALITY MEASURE in destination systems; Private EP
133 ;
134 ; Quit if C0Q Quality Measures isn't on the system.
135 Q:'$D(^C0Q(101))
136 ;
137 D MES^XPDUTL("Removing subsumed entries in C0Q QUALITY MEASURE")
138 ;
139 ; .01 field values to for records to remove
140 N C0QLIST
141 S C0QLIST("TEST M0028A")=""
142 S C0QLIST("MU EP 0028B")=""
143 S C0QLIST("M0013")=""
144 S C0QLIST("M0024")=""
145 S C0QLIST("M1")=""
146 S C0QLIST("M3")=""
147 S C0QLIST("M2")=""
148 S C0QLIST("M0028")=""
149 S C0QLIST("M111")=""
150 S C0QLIST("M112")=""
151 S C0QLIST("M113")=""
152 S C0QLIST("M128")=""
153 S C0QLIST("M5")=""
154 S C0QLIST("M7")=""
155 S C0QLIST("M0022")=""
156 S C0QLIST("12")=""
157 S C0QLIST("M0038")=""
158 S C0QLIST("M110")=""
159 S C0QLIST("MU EP NQF 0070")=""
160 ;
161 ; Root for ^DIK
162 N DIK S DIK="^C0Q(101,"
163 ;
164 ; Loop through list, find IEN for each one, kill off
165 N C0QITEM S C0QITEM="" ; Item
166 F S C0QITEM=$O(C0QLIST(C0QITEM)) Q:C0QITEM="" D ; Loop
167 . Q:'$DATA(^C0Q(101,"B",C0QITEM)) ; Quit if not present.
168 . N DA S DA=$O(^C0Q(101,"B",C0QITEM,"")) ; IEN
169 . ; The original software has MU EP NQF 0070 incorrectly. If the 1 node
170 . ; has Pneumonia, we want to remove that entry.
171 . I C0QITEM="MU EP NQF 0070",^C0Q(101,DA,1)'["Pneumonia" QUIT
172 . D MES^XPDUTL("...Removing "_C0QITEM) ; Message to user
173 . D ^DIK ; Delete
174 ;
175REN ; Rename a bunch of entries
176 ; ("OLD NAME")="NEW NAME"
177 D MES^XPDUTL("Renaming Old entries in C0Q QUALITY MEASURE")
178 ;
179 N C0QLIST
180 S C0QLIST("NQF0038 NUM1 DPT")="MU EP NQF 0038 NUM1 DPT"
181 S C0QLIST("NQF0038 NUM10")="MU EP NQF 0038 NUM10 FLU"
182 S C0QLIST("NQF0038 NUM11 COMBO5")="MU EP NQF 0038 NUM11 COMBO5"
183 S C0QLIST("NQF0038 NUM12 COMBO6")="MU EP NQF 0038 NUM12 COMBO6"
184 S C0QLIST("NQF0038 NUM2 IPV")="MU EP NQF 0038 NUM2 IPV"
185 S C0QLIST("NQF0038 NUM3 MMR")="MU EP NQF 0038 NUM3 MMR"
186 S C0QLIST("NQF0038 NUM4 HiB")="MU EP NQF 0038 NUM4 HiB"
187 S C0QLIST("NQF0038 NUM5 HEP B")="MU EP NQF 0038 NUM5 HEP B"
188 S C0QLIST("NQF0038 NUM6 VZV")="MU EP NQF 0038 NUM6 VZV"
189 S C0QLIST("NQF0038 NUM7 PCV")="MU EP NQF 0038 NUM7 PCV"
190 S C0QLIST("NQF0038 NUM8 HEP A")="MU EP NQF 0038 NUM8 HEP A"
191 S C0QLIST("NQF0038 NUM9")="MU EP NQF 0038 NUM9 RV"
192 S C0QLIST("M124")="PQRI MEASURE 124"
193 S C0QLIST("M173")="PQRI MEASURE 173"
194 S C0QLIST("M39")="PQRI MEASURE 39"
195 S C0QLIST("M47")="PQRI MEASURE 47"
196 S C0QLIST("M48")="PQRI MEASURE 48"
197 ;
198 N C0QITEM S C0QITEM="" ; Item
199 N C0QFDA ; FDA
200 F S C0QITEM=$O(C0QLIST(C0QITEM)) Q:C0QITEM="" D ; Loop through
201 . N IEN S IEN=$O(^C0Q(101,"B",C0QITEM,"")) ; Get IEN from File using old name
202 . I IEN S C0QFDA(1130580001.101,IEN_",",.01)=C0QLIST(C0QITEM) ; If found, put new name in FDA for this IEN
203 . I IEN D MES^XPDUTL("...Renaming "_C0QITEM_" to "_C0QLIST(C0QITEM)) ; Print message to user
204 ;
205 N C0QERR ; Error for FILE^DIE
206 I $D(C0QFDA) D FILE^DIE("E",$NA(C0QFDA),$NA(C0QERR)) ; File if FDA has contents
207 E D MES^XPDUTL("No entries to rename") ; If nothing, tell user so
208 ;
209 D:$D(C0QERR) ; If Error, print it
210 . D MES^XPDUTL("Error Filing Data. FILE^DIE reported:")
211 . N REF S REF=$NA(C0QERR) ; $Q Reference
212 . F S REF=$Q(@REF) Q:REF="" D MES^XPDUTL(REF_"="_@REF) ; Loop and Print
213 ;
214 QUIT
Note: See TracBrowser for help on using the repository browser.