source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOFD.m@ 1653

Last change on this file since 1653 was 1209, checked in by Sam Habiel, 13 years ago

BMXMON fix; updated all routines to v 2.31

File size: 2.8 KB
RevLine 
[645]1BMXADOFD ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
[1209]2 ;;2.31;BMX;;Jul 25, 2011
[645]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 ;
14VMEAS(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
34MG 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 ;
40ICDVAL(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 ;
47FACNIEN(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 ;
59NEXTPBN(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 ;
71NN W $$NEXTNOTE(221,4585) Q
72NEXTNOTE(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
Note: See TracBrowser for help on using the repository browser.