| 1 | BMXADOFD ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
|
|---|
| 2 | ;;2.2;BMX;;Sep 07, 2010
|
|---|
| 3 | ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
|
|---|
| 4 | ; CONTAINS SPECIAL ENTRY POINT FOR RPMS DATA ENTRY
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | ; D SS^BMXADO(.XXX,53,"","~~~~~VMEAS~BMXADOFD~1.244A||PU\60|WT\175|HT\70") Q
|
|---|
| 9 | ; D SS^BMXADO(.XXX,58,"X","AC~53~53~~~NOTES~BMXADOFD~53") Q
|
|---|
| 10 | N FILE,DAS,DATA S FILE=9000010.07,DAS="+"
|
|---|
| 11 | S DATA=".01|`8718"_$C(30)_".02|`1"_$C(30)_".03|`71168"_$C(30)_".04|DM--2"_$C(30,31)
|
|---|
| 12 | D FILE^BMXADOF(.XXX,FILE,DAS,DATA) Q
|
|---|
| 13 | ;
|
|---|
| 14 | VMEAS(DATA,IENS,MAX,OUT,TOT) ; VIEW MEASUREMENTS: CUSTOM ITERATOR
|
|---|
| 15 | ; DATA=VCN|ALL|MTYPE1\VAL1|MTYPE2\VAL2|...|MTYPEn\VALn
|
|---|
| 16 | N VAL,CNT,P,S,PTIEN,VIEN,%,X,Y,TYPE,N,ALL,STG,MEAS,MIEN,IX
|
|---|
| 17 | S P="|",S="\",N=0
|
|---|
| 18 | I '$G(TOT) Q ""
|
|---|
| 19 | I '$L(OUT) Q ""
|
|---|
| 20 | S VIEN=$P(DATA,P) I '$L(VCN) Q ""
|
|---|
| 21 | S PTIEN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'PTIEN Q ""
|
|---|
| 22 | F CNT=2:1 S X=$P(DATA,P,CNT) Q:'$L(X) D ; CREATE PRELIMINARY DATA ARRAYS
|
|---|
| 23 | . S VAL=$P(X,S,2) ; VALUE MUST EXIST
|
|---|
| 24 | . I '$L(VAL) Q
|
|---|
| 25 | . S TYPE=$P(X,S) ; TYPE MUST EXIST
|
|---|
| 26 | . I '$L(TYPE) Q
|
|---|
| 27 | . S MIEN=$O(^AUTTMSR("B",TYPE,0)) I 'MIEN Q
|
|---|
| 28 | . S MEAS=$P($G(^AUTTMSR(MIEN,0)),U,2) I '$L(MEAS) Q
|
|---|
| 29 | . S N=N+1
|
|---|
| 30 | . S VAL(N)=VAL
|
|---|
| 31 | . S TYPE(N)=MIEN_U_TYPE_U_MEAS
|
|---|
| 32 | . S IX(MIEN)=N
|
|---|
| 33 | . Q
|
|---|
| 34 | MG S N=0 F S N=$O(VAL(N)) Q:'N D
|
|---|
| 35 | . S TOT=TOT+1
|
|---|
| 36 | . 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)
|
|---|
| 37 | . Q
|
|---|
| 38 | Q ""
|
|---|
| 39 | ;
|
|---|
| 40 | ICDVAL(CODE) ; EP-RPC-VERIFY ICD CODE BY RETURNING ITS IEN
|
|---|
| 41 | I '$L($G(CODE)) Q ""
|
|---|
| 42 | N IEN
|
|---|
| 43 | S IEN=$O(^ICD9("BA",CODE_" ",0))
|
|---|
| 44 | I 'IEN Q ""
|
|---|
| 45 | Q IEN
|
|---|
| 46 | ;
|
|---|
| 47 | FACNIEN(PIEN,FIEN) ;EP - GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN
|
|---|
| 48 | I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
|
|---|
| 49 | I '$D(^DIC(4,+$G(FIEN),0)) Q ""
|
|---|
| 50 | N NFIEN
|
|---|
| 51 | S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT
|
|---|
| 52 | ; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE
|
|---|
| 53 | S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1
|
|---|
| 54 | S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN
|
|---|
| 55 | S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^"
|
|---|
| 56 | S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)=""
|
|---|
| 57 | Q FNIEN
|
|---|
| 58 | ;
|
|---|
| 59 | NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY
|
|---|
| 60 | N MAX,PIEN,X,Y
|
|---|
| 61 | S MAX=0,PIEN=0
|
|---|
| 62 | F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT
|
|---|
| 63 | . S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
|
|---|
| 64 | . I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY
|
|---|
| 65 | . S Y=$P(X,U,7)
|
|---|
| 66 | . I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR
|
|---|
| 67 | . Q
|
|---|
| 68 | S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER
|
|---|
| 69 | Q MAX
|
|---|
| 70 | ;
|
|---|
| 71 | NN W $$NEXTNOTE(221,4585) Q
|
|---|
| 72 | NEXTNOTE(PIEN,FIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY
|
|---|
| 73 | I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
|
|---|
| 74 | I '$D(^DIC(4,+$G(FIEN),0)) Q ""
|
|---|
| 75 | N MAX,NIEN,FNIEN,X,Y
|
|---|
| 76 | S MAX=0,NIEN=0
|
|---|
| 77 | S FNIEN=$$FACNIEN^BMXADOFD(PIEN,FIEN) I 'FNIEN Q ""
|
|---|
| 78 | F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D
|
|---|
| 79 | . S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q
|
|---|
| 80 | . S Y=+X
|
|---|
| 81 | . I Y>MAX S MAX=Y
|
|---|
| 82 | . Q
|
|---|
| 83 | S MAX=MAX+1
|
|---|
| 84 | Q MAX
|
|---|
