| 1 | C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/3/12 8:38am
|
|---|
| 2 | ;;1.0;C0Q;;May 21, 2012;Build 47
|
|---|
| 3 | ; Licensed under package license. See Documentation.
|
|---|
| 4 | ;
|
|---|
| 5 | ; PEPs: PRE, TRAN, POST
|
|---|
| 6 | ;
|
|---|
| 7 | PRE ; Unified Pre; PEP
|
|---|
| 8 | D PREREM
|
|---|
| 9 | QUIT
|
|---|
| 10 | TRAN ; Unified Transport; PEP
|
|---|
| 11 | ; D TRAN301 ; looks like I won't send that file over
|
|---|
| 12 | D TRAN201
|
|---|
| 13 | QUIT
|
|---|
| 14 | POST ; Unified Post; PEP
|
|---|
| 15 | ; D POST301 ; looks like I won't send that file over
|
|---|
| 16 | D POST101
|
|---|
| 17 | D POST201
|
|---|
| 18 | D POSTREM
|
|---|
| 19 | QUIT
|
|---|
| 20 | ;
|
|---|
| 21 | ; << >>
|
|---|
| 22 | ;
|
|---|
| 23 | TRAN301 ; 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 | ;
|
|---|
| 35 | TRAN201 ; 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 | ;
|
|---|
| 59 | POST201 ; 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 | ;
|
|---|
| 73 | POST301 ; 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 | ;
|
|---|
| 83 | POST101 ; 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
|
|---|
| 107 | ;
|
|---|
| 108 | ; Code below taken from PXRMP15I
|
|---|
| 109 | ;===============================================================
|
|---|
| 110 | ARRAY(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 | ;===============================================================
|
|---|
| 117 | DELEI ;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 | ;===============================================================
|
|---|
| 135 | EXFINC(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 | ;
|
|---|
| 148 | PREREM ;
|
|---|
| 149 | D DELEI
|
|---|
| 150 | Q
|
|---|
| 151 | POSTREM ;
|
|---|
| 152 | D SMEXINS
|
|---|
| 153 | Q
|
|---|
| 154 | ;===============================================================
|
|---|
| 155 | SMEXINS ;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 | ;
|
|---|
| 171 | CRPL(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
|
|---|
