BMXADOFD	; 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 ENTRY POINT FOR RPMS DATA ENTRY
	; 
	; 
	;
	; D SS^BMXADO(.XXX,53,"","~~~~~VMEAS~BMXADOFD~1.244A||PU\60|WT\175|HT\70") Q
	; D SS^BMXADO(.XXX,58,"X","AC~53~53~~~NOTES~BMXADOFD~53") Q
	N FILE,DAS,DATA S FILE=9000010.07,DAS="+"
	S DATA=".01|`8718"_$C(30)_".02|`1"_$C(30)_".03|`71168"_$C(30)_".04|DM--2"_$C(30,31)
	D FILE^BMXADOF(.XXX,FILE,DAS,DATA) Q
	; 
VMEAS(DATA,IENS,MAX,OUT,TOT)	; VIEW MEASUREMENTS: CUSTOM ITERATOR
	; DATA=VCN|ALL|MTYPE1\VAL1|MTYPE2\VAL2|...|MTYPEn\VALn
	N VAL,CNT,P,S,PTIEN,VIEN,%,X,Y,TYPE,N,ALL,STG,MEAS,MIEN,IX
	S P="|",S="\",N=0
	I '$G(TOT) Q ""
	I '$L(OUT) Q ""
	S VIEN=$P(DATA,P) I '$L(VCN) Q ""
	S PTIEN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'PTIEN Q ""
	F CNT=2:1 S X=$P(DATA,P,CNT) Q:'$L(X)  D  ; CREATE PRELIMINARY DATA ARRAYS
	. S VAL=$P(X,S,2) ; VALUE MUST EXIST
	. I '$L(VAL) Q
	. S TYPE=$P(X,S) ; TYPE MUST EXIST
	. I '$L(TYPE) Q
	. S MIEN=$O(^AUTTMSR("B",TYPE,0)) I 'MIEN Q
	. S MEAS=$P($G(^AUTTMSR(MIEN,0)),U,2) I '$L(MEAS) Q
	. S N=N+1
	. S VAL(N)=VAL
	. S TYPE(N)=MIEN_U_TYPE_U_MEAS
	. S IX(MIEN)=N
	. Q
MG	S N=0 F  S N=$O(VAL(N)) Q:'N  D
	. S TOT=TOT+1
	. S @OUT@(TOT)=+TYPE(N)_U_$P(TYPE(N),U,2)_U_"`"_PTIEN_U_"`"_VIEN_U_VAL(N)_U_$P(TYPE(N),U,3)_$C(30)
	. Q
	Q ""
	;
ICDVAL(CODE)	; EP-RPC-VERIFY ICD CODE BY RETURNING ITS IEN
	I '$L($G(CODE)) Q ""
	N IEN
	S IEN=$O(^ICD9("BA",CODE_" ",0))
	I 'IEN Q ""
	Q IEN
	;
FACNIEN(PIEN,FIEN)	;EP - 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 NFIEN
	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(221,4585) Q
NEXTNOTE(PIEN,FIEN)	; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY
	I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
	I '$D(^DIC(4,+$G(FIEN),0)) Q ""
	N MAX,NIEN,FNIEN,X,Y
	S MAX=0,NIEN=0
	S FNIEN=$$FACNIEN^BMXADOFD(PIEN,FIEN) I 'FNIEN Q ""
	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