C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/3/12 8:38am ;;1.0;C0Q;;May 21, 2012;Build 47 ; Licensed under package license. See Documentation. ; ; PEPs: PRE, TRAN, POST ; PRE ; Unified Pre; PEP D PREREM QUIT TRAN ; Unified Transport; PEP ; D TRAN301 ; looks like I won't send that file over D TRAN201 QUIT POST ; Unified Post; PEP ; D POST301 ; looks like I won't send that file over D POST101 D POST201 D POSTREM QUIT ; ; << >> ; TRAN301 ; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP N C0QIEN S C0QIEN=0 ; IEN walker N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference K @C0QREF1,@C0QREF2 ; Kill that F S C0QIEN=$O(^C0Q(301,C0QIEN)) Q:'+C0QIEN D . D GETS^DIQ(1130580001.301,C0QIEN_",","*","",C0QREF1) ; Load FDA's in there . M @C0QREF2@(1130580001.301,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.301,C0QIEN_",") ; Change IENs to ?+ IENs M @XPDGREF@("C0Q","1130580001.301")=@C0QREF2 ; Put in Transport Global K @C0QREF1,@C0QREF2 ; Remove QUIT ; TRAN201 ; Grab FDA for 201 C0Q MEASUREMENTS selected fields; Private EP N C0QIEN S C0QIEN=0 ; IEN walker N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference K @C0QREF1,@C0QREF2 ; Kill that ; ; We need C0QCOUNT so that it wouldn't reuse the numbers, b/c updater wants numbers for every different item N C0QCOUNT S C0QCOUNT=$O(^C0Q(201," "),-1) ; Counter for SubIENs for destination array; init at highest IEN to prevent dups F S C0QIEN=$O(^C0Q(201,C0QIEN)) Q:'+C0QIEN D ; Walk IENs . W "Exporting "_C0QIEN,! . ; Fields SET NAME, BEGIN DATE, END DATE, LOCKED, USE ALL MEASURES, MU YEAR KEY . D GETS^DIQ(1130580001.201,C0QIEN_",",".01;.02;.03;.05;.2;.3","",C0QREF1) . M @C0QREF2@(1130580001.201,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.201,C0QIEN_",") ; Change IENs to ?+ IENs . N C0QIEN2 S C0QIEN2=0 ; Subfile walker . F S C0QIEN2=$O(^C0Q(201,C0QIEN,5,C0QIEN2)) Q:'+C0QIEN2 D ; MEASURE subfile . . W "Exporting IENS "_C0QIEN2_","_C0QIEN_",",! . . D GETS^DIQ(1130580001.2011,C0QIEN2_","_C0QIEN_",",".01","",C0QREF1) ; MEASURE (#.01) . . S C0QCOUNT=C0QCOUNT+1 ; Increment the counter for SubIEN (can't reuse) . . M @C0QREF2@(1130580001.2011,"?+"_C0QCOUNT_","_"?+"_C0QIEN_",")=@C0QREF1@(1130580001.2011,C0QIEN2_","_C0QIEN_",") ; as above ; M @XPDGREF@("C0Q","1130580001.201")=@C0QREF2 ; Put in transport global K @C0QREF1,@C0QREF2 ; Remove temp QUIT ; POST201 ; File FDA for 201; Private EP IF $O(^C0Q(201,0)) DO QUIT ; Quit if data is already there. . D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data") ; D MES^XPDUTL("Adding data to C0Q MEASUREMENTS") N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.201")) ; Grab FDA from Transport Global N C0QERR ; Error array for filer D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all I $D(C0QERR) D ; if there's an error, print it out . D MES^XPDUTL("Couldn't add data into C0Q MEASUREMENTS") . S C0QERR=$Q(C0QERR) . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR) QUIT ; POST301 ; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference N C0QERR ; Error D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all I $D(C0QERR) D ; if there's an error, print it out . D MES^XPDUTL("Couldn't add data into C0Q PATIENT LIST file") . S C0QERR=$Q(C0QERR) . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR) QUIT ; POST101 ; Clean transported data from broken pointers in C0Q QUALITY MEASURE in destination systems; Private EP D MES^XPDUTL("Cleaning C0Q QUALITY MEASURE data") N C0QIEN S C0QIEN=0 ; Ien looper N C0QFDA ; Fileman Data Array F S C0QIEN=$O(^C0Q(101,C0QIEN)) Q:'+C0QIEN DO ; For each record, delete these fields . S C0QFDA(1130580001.101,C0QIEN_",",1)="@" ; NUMERATOR PATIENT LIST . S C0QFDA(1130580001.101,C0QIEN_",",1.5)="@" ; NEGATIVE NUMERATOR LIST . S C0QFDA(1130580001.101,C0QIEN_",",2)="@" ; DENOMINATOR PATIENT LIST . ; --- . ; I wasn't planning on emptying these out, but the IENs in desintation systems may be different . ; so it is best to remove them for now. It's a pointer field, so IENs are important. . ; Desination file is populated automatically, but only at the site, and only after config. . ; So we can't really ship the pointers as part of the install. . ; --- . S C0QFDA(1130580001.101,C0QIEN_",",1.1)="@" ; ALTERNATIVE NUMERATOR LIST . S C0QFDA(1130580001.101,C0QIEN_",",1.51)="@" ; ALTERNATE NEGATIVE NUM LIST . S C0QFDA(1130580001.101,C0QIEN_",",2.1)="@" ; ALTERNATIVE DENOMINATOR LIST N C0QERR ; Errors D FILE^DIE("","C0QFDA","C0QERR") ; Do it! I $D(C0QERR) D ; if there's an error, print it out . D MES^XPDUTL("Couldn't fix data into C0Q QUALITY MEASURE file") . S C0QERR=$Q(C0QERR) . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR) QUIT ; ; Code below taken from PXRMP15I ;=============================================================== ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install ; S ARRAY(1,1)="MU NQF0024 BMI_MK" I MODE S ARRAY(1,2)="07/06/2011@15:11:46" Q ; ;=============================================================== DELEI ;If the Exchange File entry already exists delete it. N ARRAY,IC,IND,LIST,LUVALUE,NUM D ARRAY(1,.ARRAY) S IC=0 F S IC=$O(ARRAY(IC)) Q:'IC D .S LUVALUE(1)=ARRAY(IC,1) .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST") .I '$D(LIST) Q .S NUM=$P(LIST("DILIST",0),U,1) .I NUM'=0 D ..F IND=1:1:NUM D ... N DA,DIK ... S DIK="^PXD(811.8," ... S DA=LIST("DILIST",2,IND) ... D ^DIK Q ; ;=============================================================== EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to ;include in the build. This is used in the build to determine which ;entries to include. N ARRAY,FOUND,IEN,IC,LUVALUE D ARRAY(1,.ARRAY) S FOUND=0 S IC=0 F S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND) D . M LUVALUE=ARRAY(IC) . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE) . I IEN=Y S FOUND=1 Q Q FOUND ; PREREM ; D DELEI Q POSTREM ; D SMEXINS Q ;=============================================================== SMEXINS ;Silent mode install. N ARRAY,IC,IEN,LUVALUE,PXRMINST S PXRMINST=1 D ARRAY(1,.ARRAY) S IC=0 F S IC=$O(ARRAY(IC)) Q:'IC D .M LUVALUE=ARRAY(IC) .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE) .I IEN'=0 D .. N TEXT .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1) .. E S TEXT="Installing reminder "_LUVALUE(1) .. D BMES^XPDUTL(TEXT) .. D INSTALL^PXRMEXSI(IEN,"I",1) Q ; CRPL(PLNAME,C0QERR) ; Private ; $$ ; Create Patient List ; Input: PLNAME: By Value: Patient List Name ; C0QERR: By Ref: Error Array ; Output: IEN of Patient List, or -1 for error N C0QFDA,C0QIENS ; FDA, return IEN S C0QFDA(810.5,"?+1,",.01)=PLNAME ; Patient List Name S C0QFDA(810.5,"?+1,",.07)="`"_DUZ ; Creator S C0QFDA(810.5,"?+1,",.08)="PUB" ; Type: Public S C0QFDA(810.5,"?+1,",100)="L" ; Class: Local D UPDATE^DIE("E",$NA(C0QFDA),$NA(C0QIENS),$NA(C0QERR)) ; External Flag I $G(C0QIENS(1)) QUIT C0QIENS(1) E QUIT -1