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

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

a new version Work in Progress version of C0QKIDS
File size: 7.2 KB
RevLine 
[1465]1C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/3/12 8:38am
2 ;;1.0;C0Q;;May 21, 2012;Build 47
[1438]3 ; Licensed under package license. See Documentation.
4 ;
[1465]5 ; PEPs: PRE, TRAN, POST
[1438]6 ;
[1465]7PRE ; Unified Pre; PEP
8 D PREREM
9 QUIT
[1438]10TRAN ; Unified Transport; PEP
11 ; D TRAN301 ; looks like I won't send that file over
12 D TRAN201
13 QUIT
14POST ; Unified Post; PEP
15 ; D POST301 ; looks like I won't send that file over
16 D POST101
17 D POST201
[1465]18 D POSTREM
[1438]19 QUIT
20 ;
21 ; << >>
22 ;
23TRAN301 ; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP
24 N C0QIEN S C0QIEN=0 ; IEN walker
25 N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
26 N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
27 K @C0QREF1,@C0QREF2 ; Kill that
28 F S C0QIEN=$O(^C0Q(301,C0QIEN)) Q:'+C0QIEN D
29 . D GETS^DIQ(1130580001.301,C0QIEN_",","*","",C0QREF1) ; Load FDA's in there
30 . M @C0QREF2@(1130580001.301,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.301,C0QIEN_",") ; Change IENs to ?+ IENs
31 M @XPDGREF@("C0Q","1130580001.301")=@C0QREF2 ; Put in Transport Global
32 K @C0QREF1,@C0QREF2 ; Remove
33 QUIT
34 ;
35TRAN201 ; Grab FDA for 201 C0Q MEASUREMENTS selected fields; Private EP
36 N C0QIEN S C0QIEN=0 ; IEN walker
37 N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
38 N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
39 K @C0QREF1,@C0QREF2 ; Kill that
40 ;
41 ; We need C0QCOUNT so that it wouldn't reuse the numbers, b/c updater wants numbers for every different item
42 N C0QCOUNT S C0QCOUNT=$O(^C0Q(201," "),-1) ; Counter for SubIENs for destination array; init at highest IEN to prevent dups
43 F S C0QIEN=$O(^C0Q(201,C0QIEN)) Q:'+C0QIEN D ; Walk IENs
44 . W "Exporting "_C0QIEN,!
45 . ; Fields SET NAME, BEGIN DATE, END DATE, LOCKED, USE ALL MEASURES, MU YEAR KEY
46 . D GETS^DIQ(1130580001.201,C0QIEN_",",".01;.02;.03;.05;.2;.3","",C0QREF1)
47 . M @C0QREF2@(1130580001.201,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.201,C0QIEN_",") ; Change IENs to ?+ IENs
48 . N C0QIEN2 S C0QIEN2=0 ; Subfile walker
49 . F S C0QIEN2=$O(^C0Q(201,C0QIEN,5,C0QIEN2)) Q:'+C0QIEN2 D ; MEASURE subfile
50 . . W "Exporting IENS "_C0QIEN2_","_C0QIEN_",",!
51 . . D GETS^DIQ(1130580001.2011,C0QIEN2_","_C0QIEN_",",".01","",C0QREF1) ; MEASURE (#.01)
52 . . S C0QCOUNT=C0QCOUNT+1 ; Increment the counter for SubIEN (can't reuse)
53 . . M @C0QREF2@(1130580001.2011,"?+"_C0QCOUNT_","_"?+"_C0QIEN_",")=@C0QREF1@(1130580001.2011,C0QIEN2_","_C0QIEN_",") ; as above
54 ;
55 M @XPDGREF@("C0Q","1130580001.201")=@C0QREF2 ; Put in transport global
56 K @C0QREF1,@C0QREF2 ; Remove temp
57 QUIT
58 ;
59POST201 ; File FDA for 201; Private EP
60 IF $O(^C0Q(201,0)) DO QUIT ; Quit if data is already there.
61 . D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data")
62 ;
63 D MES^XPDUTL("Adding data to C0Q MEASUREMENTS")
64 N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.201")) ; Grab FDA from Transport Global
65 N C0QERR ; Error array for filer
66 D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
67 I $D(C0QERR) D ; if there's an error, print it out
68 . D MES^XPDUTL("Couldn't add data into C0Q MEASUREMENTS")
69 . S C0QERR=$Q(C0QERR)
70 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR)
71 QUIT
72 ;
73POST301 ; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP
74 N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference
75 N C0QERR ; Error
76 D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
77 I $D(C0QERR) D ; if there's an error, print it out
78 . D MES^XPDUTL("Couldn't add data into C0Q PATIENT LIST file")
79 . S C0QERR=$Q(C0QERR)
80 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR)
81 QUIT
82 ;
83POST101 ; Clean transported data from broken pointers in C0Q QUALITY MEASURE in destination systems; Private EP
84 D MES^XPDUTL("Cleaning C0Q QUALITY MEASURE data")
85 N C0QIEN S C0QIEN=0 ; Ien looper
86 N C0QFDA ; Fileman Data Array
87 F S C0QIEN=$O(^C0Q(101,C0QIEN)) Q:'+C0QIEN DO ; For each record, delete these fields
88 . S C0QFDA(1130580001.101,C0QIEN_",",1)="@" ; NUMERATOR PATIENT LIST
89 . S C0QFDA(1130580001.101,C0QIEN_",",1.5)="@" ; NEGATIVE NUMERATOR LIST
90 . S C0QFDA(1130580001.101,C0QIEN_",",2)="@" ; DENOMINATOR PATIENT LIST
91 . ; ---
92 . ; I wasn't planning on emptying these out, but the IENs in desintation systems may be different
93 . ; so it is best to remove them for now. It's a pointer field, so IENs are important.
94 . ; Desination file is populated automatically, but only at the site, and only after config.
95 . ; So we can't really ship the pointers as part of the install.
96 . ; ---
97 . S C0QFDA(1130580001.101,C0QIEN_",",1.1)="@" ; ALTERNATIVE NUMERATOR LIST
98 . S C0QFDA(1130580001.101,C0QIEN_",",1.51)="@" ; ALTERNATE NEGATIVE NUM LIST
99 . S C0QFDA(1130580001.101,C0QIEN_",",2.1)="@" ; ALTERNATIVE DENOMINATOR LIST
100 N C0QERR ; Errors
101 D FILE^DIE("","C0QFDA","C0QERR") ; Do it!
102 I $D(C0QERR) D ; if there's an error, print it out
103 . D MES^XPDUTL("Couldn't fix data into C0Q QUALITY MEASURE file")
104 . S C0QERR=$Q(C0QERR)
105 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR)
106 QUIT
[1465]107 ;
108 ; Code below taken from PXRMP15I
109 ;===============================================================
110ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
111 ;
112 S ARRAY(1,1)="MU NQF0024 BMI_MK"
113 I MODE S ARRAY(1,2)="07/06/2011@15:11:46"
114 Q
115 ;
116 ;===============================================================
117DELEI ;If the Exchange File entry already exists delete it.
118 N ARRAY,IC,IND,LIST,LUVALUE,NUM
119 D ARRAY(1,.ARRAY)
120 S IC=0
121 F S IC=$O(ARRAY(IC)) Q:'IC D
122 .S LUVALUE(1)=ARRAY(IC,1)
123 .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
124 .I '$D(LIST) Q
125 .S NUM=$P(LIST("DILIST",0),U,1)
126 .I NUM'=0 D
127 ..F IND=1:1:NUM D
128 ... N DA,DIK
129 ... S DIK="^PXD(811.8,"
130 ... S DA=LIST("DILIST",2,IND)
131 ... D ^DIK
132 Q
133 ;
134 ;===============================================================
135EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
136 ;include in the build. This is used in the build to determine which
137 ;entries to include.
138 N ARRAY,FOUND,IEN,IC,LUVALUE
139 D ARRAY(1,.ARRAY)
140 S FOUND=0
141 S IC=0
142 F S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND) D
143 . M LUVALUE=ARRAY(IC)
144 . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
145 . I IEN=Y S FOUND=1 Q
146 Q FOUND
147 ;
148PREREM ;
149 D DELEI
150 Q
151POSTREM ;
152 D SMEXINS
153 Q
154 ;===============================================================
155SMEXINS ;Silent mode install.
156 N ARRAY,IC,IEN,LUVALUE,PXRMINST
157 S PXRMINST=1
158 D ARRAY(1,.ARRAY)
159 S IC=0
160 F S IC=$O(ARRAY(IC)) Q:'IC D
161 .M LUVALUE=ARRAY(IC)
162 .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
163 .I IEN'=0 D
164 .. N TEXT
165 .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
166 .. E S TEXT="Installing reminder "_LUVALUE(1)
167 .. D BMES^XPDUTL(TEXT)
168 .. D INSTALL^PXRMEXSI(IEN,"I",1)
169 Q
170 ;
171CRPL(PLNAME,C0QERR) ; Private ; $$ ; Create Patient List
172 ; Input: PLNAME: By Value: Patient List Name
173 ; C0QERR: By Ref: Error Array
174 ; Output: IEN of Patient List, or -1 for error
175 N C0QFDA,C0QIENS ; FDA, return IEN
176 S C0QFDA(810.5,"?+1,",.01)=PLNAME ; Patient List Name
177 S C0QFDA(810.5,"?+1,",.07)="`"_DUZ ; Creator
178 S C0QFDA(810.5,"?+1,",.08)="PUB" ; Type: Public
179 S C0QFDA(810.5,"?+1,",100)="L" ; Class: Local
180 D UPDATE^DIE("E",$NA(C0QFDA),$NA(C0QIENS),$NA(C0QERR)) ; External Flag
181 I $G(C0QIENS(1)) QUIT C0QIENS(1)
182 E QUIT -1
Note: See TracBrowser for help on using the repository browser.