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
