BMXADOFS	; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
	;;2.1;BMX;;Jul 26, 2009
	; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
	; CONTAINS SPECIAL CODE RELATED TO FILING PROPLEMS, POVS, FAMILY HX, PERSONAL HX AND NOTES.
	; 
	; 
	;
PAT	; TEST PROBLEM ADD
	S DATA=".01|`8257"_$C(30)_".02|`53"_$C(30)_".03|"_DT_$C(30)_".05|C-POX"_$C(30)_".06|`4585"_$C(30)_".12|I"_$C(30,31)
	D FILE^BMXADOF(.XXX,9000011,"",DATA) W !,XXX K XXX,DATA Q
	; 
PET	; TEST PROB EDIT
	S DATA=".01|250.00"_$C(30)_".03|"_DT_$C(30)_".05|HI MOM"_$C(30)_".12|I"_$C(30,31)
	D FILE^BMXADOF(.XXX,9000011,"1757",DATA) W !,XXX K XXX,DATA Q
	; 
TDP	; TEST PROBLEM DELETE
	S DATA=$C(31)
	D FILE^BMXADOF(.XXX,9000011,"-1757",DATA) W !,XXX K XXX,DATA Q
	; 
TPOV	; ADD POV TEST
	S DATA=".01|`8718"_$C(30)_".02|`53"_$C(30)_".03|`3909"_$C(30)_".04|DM---I"_$C(30)_".12|P"_$C(30,31)
	D FILE^BMXADOF(.XXX,9000010.07,"",DATA) W !,XXX K XXX,DATA Q
	;
TH	; HX TEST
	S DATA=".01|250.00"_$C(30)_".02|`53"_$C(30)_".03|JUL 15,2004"_$C(30)_".04|FAMILY HX OF LUNG CA"_$C(30,31)
	D FILE^BMXADOF(.XXX,9000014,"",DATA) W !,XXX K XXX,DATA Q
	;
TNOTE	; TEST ADDING A NOTE TO A PROBLEM
	N DATA,XXX,PROBIEN,FACNIEN,FACIEN,DAS
	S PROBIEN=3,FACIEN=4587
	S FACNIEN=$$FACNIEN(PROBIEN,FACIEN) ; YOU MUST SPECIFY THE PROBLEM IEN AND THE FACILITY IEN
	S DAS=PROBIEN_","_FACNIEN_","
	S DATA=".03|NEW NOTE #2"_$C(30,31) ; THE DATA STRING JUST CONTAINS THE NOTE FIELD.
	; THE OTHER FIELDS (INCLUDING .01) ARE ADDED BY BMXADOF
	D FILE^BMXADOF(.XXX,9000011.1111,DAS,DATA) W !,XXX
	Q
	;
	; -----------------------------------------------------------------------------------------------------
	; 
SPEC(FILE,DATA,UFLG)	;EP - SPECIAL DATA MODS FOR SPECIFIC FILES
	I FILE=9000010.07 S DATA=$$POV(DATA) Q DATA
	I FILE=9000011 S DATA=$$PROB(DATA,$G(UFLG)) Q DATA
	I FILE=9000013!(FILE=9000014) S DATA=$$HX(DATA) Q DATA
	I FILE=9000011.1111 S DATA=$$NOTE(DATA,$G(DAS(2)),$G(DAS(1))) Q DATA
	; I FILE=9000010.18,DATA'["|.04|" G DSTG
	Q DATA
	;
HX(DATA)	; INPUT STRING TRANSFORM FOR PHX AND FHX
	N NARR,NIEN,%,A,B,X,Y,%DT
	I DATA[".01|`" G HNARR
	S DATA=$$ICD(DATA,.01) I DATA="" Q ""
HNARR	I DATA'[".04|'" G HDT
	S DATA=$$NARR(DATA,.04)
HDT	I DATA'[".03|" Q DATA
	S X=+$P(DATA,".03|",2) I X?7N Q DATA
	S %DT="" D ^%DT
	I Y'?7N Q DATA
	S A=$P(DATA,".03|")
	S B=$P(DATA,".03|",2) S B=$P(B,$C(30),2)
	S DATA=A_".03|"_Y
	I $L(B) S DATA=DATA_$C(30)_B
	Q DATA
	; 
POV(DATA)	; POV INPUT STRING TRANSFORM
	N NARR,NIEN,%
	I DATA[".01|`" G PVNARR
	S DATA=$$ICD(DATA,.01) I DATA="" Q ""
PVNARR	I DATA'[".04|'" Q DATA
	S DATA=$$NARR(DATA,.04)
	Q DATA
	; 
PROB(DATA,UFLG)	; PROBLEM LIST INPUT STRING TRANSFORM
	N NARR,NIEN,%,PNUM,FACIEN,DFN,X,A,B
PNARR	I DATA'[".05|" G PICD
	S %=$P(DATA,".05|",2)
	S NARR=$P(%,$C(30))
	I NARR'?1"`"1.N S DATA=$$NARR(DATA,.05) ; STUFF THE NARR LOOKUP VALUE IN THE DATA STRING
	I '$L(DATA) Q ""
PICD	S %=$P(DATA,"|") I %'=.01,DATA'[($C(30)_".01|") G PNUM
	S DATA=$$ICD(DATA,.01) I DATA="" Q ""
PNUM	I $G(UFLG)="E" Q DATA ; STOP HERE IF IN EDIT MODE
	I $P(DATA,($C(30)_".07|"),2) G TODAY ; GET NEXT PROB NUM
	S DFN=+$P(DATA,".02|`",2)
	I 'DFN S DATA="" Q ""
	S FACIEN=+$P(DATA,".06|`",2)
	I 'FACIEN Q ""
	S PNUM=$$NEXTPBN(DFN,FACIEN)
	I 'PNUM Q ""
	S X=$L(DATA,$C(30))
	S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
	S DATA=A_$C(30)_".07|"_PNUM_$C(30)_B
TODAY	I $P(DATA,($C(30)_".08|"),2) Q DATA ; GET TODAY'S DATE
	S X=$L(DATA,$C(30))
	S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
	S DATA=A_$C(30)_".08|"_$G(DT)_$C(30)_B
	Q DATA
	;
NOTE(DATA,PIEN,FNIEN)	; GIVEN A DATA STRING CONTAINING THE NOTE, THE PROBLEM IEN, AND THE FAC-NOTE IEN:
	; ADD NOTE # AND STATUS TO THE DATA STRING
	I $G(DATA)'[".03|" Q ""
	I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
	N NUM
	I DATA'[".04|" S DATA=".04|A"_$C(30)_DATA
	I DATA'[".01|" D
	. S NUM=$$NEXTNOTE(PIEN,FNIEN)
	. I 'NUM Q
	. S DATA=".01|"_NUM_$C(30)_DATA
	Q DATA
	;
TI	N XXX S XXX=$$ICD(".01|250.00"_$C(30)_".02|123"_$C(30)_".03|ABC",.01) W !,$TR(XXX,$C(30),"{") Q
ICD(DATA,FLD)	; VERIFY ICD CODE AND GET LOOKUP VALUE
	I '$G(FLD) Q ""
	I '$L($G(DATA)) Q ""
	N %,A,B
	S %=$P(DATA,"|")
	I %=FLD D  Q DATA
	. S %=$P(DATA,"|",2)
	. S %=$P(%,$C(30))
	. I %?1"`"1.N Q
	. S %=$O(^ICD9("BA",%_" ",0))
	. I '% S DATA="" Q
	. S A=$P(DATA,"|")
	. S B=$P(DATA,"|",2,999)
	. S B=$P(B,$C(30),2,999)
	. S DATA=A_"|`"_%
	. I $L(B) S DATA=DATA_$C(30)_B
	. Q
	S %=$P(DATA,($C(30)_FLD_"|"),2) D
	. S %=$P(%,$C(30))
	. I %?1"`"1.N Q DATA
	. S %=$O(^ICD9("BA",%_" ",0))
	. I '% S DATA="" Q
	. S A=$P(DATA,($C(30)_FLD_"|"))
	. S B=$P(DATA,($C(30)_FLD_"|"),2,999)
	. S B=$P(B,$C(30),2,999)
	. S DATA=A_$C(30)_FLD_"|`"_%
	. I $L(B) S DATA=DATA_$C(30)_B
	. Q
	Q DATA
	; 
NARR(DATA,FLD)	; SUBSTITUTE A LOOKUP VALUE FOR NARRATIVE DATA IN THE DATA STRING
	N A,B,C,X,Y,DIC,Z
	I '$G(FLD) Q ""
	I '$L($G(DATA)) Q ""
	S Z=FLD_"|"
	S A=$P(DATA,Z)
	S B=$P(DATA,Z,2)
	S NARR=$P(B,$C(30))
	S NARR=$$UP^XLFSTR(NARR) ; CONVERT ALL NARRATIVE TO UPPERCASE
	S C=$P(B,$C(30),2,999)
	S DIC="^AUTNPOV(",DIC(0)="L",X=NARR
	D ^DIC I Y=-1 Q ""
	S DATA=A_FLD_"|`"_+Y
	I $L(C) S DATA=DATA_$C(30)_C
	D ^XBFMK
	Q DATA
	;
FACNIEN(PIEN,FIEN)	; GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN
	I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
	I '$D(^DIC(4,+$G(FIEN),0)) Q ""
	N FNIEN
	S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT
	; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE
	S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1
	S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN
	S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^"
	S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)=""
	Q FNIEN
	;
NEXTPBN(DFN,FIEN)	; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY
	N MAX,PIEN,X,Y
	S MAX=0,PIEN=0
	F  S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN  D  ; FIND ALL PROBLEMS FOR THIS PATIENT
	. S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
	. I $P(X,U,6)'=FIEN Q  ; ONLY CHECK NUMBERS AT THIS FACILITY
	. S Y=$P(X,U,7)
	. I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR
	. Q
	S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER
	Q MAX
	;
NN	W $$NEXTNOTE(3,1) Q
NEXTNOTE(PIEN,FNIEN)	; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY-NOTE IEN
	I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
	N MAX,NIEN,X,Y
	S MAX=0,NIEN=0
	F  S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN  D
	. S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q
	. S Y=+X
	. I Y>MAX S MAX=Y
	. Q
	S MAX=MAX+1
	Q MAX
	;
PIENN(PIEN)	; GIVEN A PROBLEM IEN, RETURN PROBLEM NARRATIVE (ICD)
	N X,IIEN,NIEN,NARR,ICD
	S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
	S IIEN=$P(X,U) I 'IIEN Q ""
	S NIEN=$P(X,U,5) I 'NIEN Q ""
	S ICD=$P($G(^ICD9(IIEN,0)),U) I '$L(ICD) Q ""
	S NARR=$P($G(^AUTNPOV(NIEN,0)),U) I '$L(NARR) Q ""
	S X=NARR_" ("_ICD_")"
	Q X
	;