source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPIX.m@ 623

Last change on this file since 623 was 623, checked in by George Lilly, 14 years ago

revised back to 6/30/08 version

File size: 4.8 KB
Line 
1ORWGAPIX ; SLC/STAFF - Graph External Calls ;9/29/06 11:49
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
3 ;
4DATE(X) ; $$(date/time) -> date/time
5 N Y D ^%DT
6 Q Y
7ENDIQ1(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
8 N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
9 Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
10 S NUMDIC=DIC
11 D EN^DIQ1
12 M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
13 K ^UTILITY("DIQ1",$J)
14 Q
15EXT(Y,FILE,FIELD) ; $$(value,file,field) -> external value
16 N C S C=$P($G(^DD(FILE,FIELD,0)),U,2) D Y^DIQ
17 Q Y
18EXTERNAL(FILE,FIELD,FLAG,VAL) ; $$(file,field,flag,internal value) -> external value
19 Q $$EXTERNAL^DILFD(FILE,FIELD,FLAG,VAL)
20EXTNAME(IEN,FN) ; $$(ien,file#) -> external form of pointer
21 N REF
22 S REF=$G(^DIC(FN,0,"GL"))
23 I $L(REF),+IEN Q $P($G(@(REF_IEN_",0)")),U)
24 Q ""
25FILENM(FILENUM) ; $$(file#) -> file name
26 N DIC,DO,NAME K DIC,DO
27 S FILENUM=$$GBLREF(+$G(FILENUM))
28 I '$L($G(FILENUM)) Q ""
29 S DIC=FILENUM
30 D DO^DIC1
31 S NAME=$P(DO,U)
32 Q NAME
33GETDATA(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
34 N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
35 Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
36 S NUMDIC=DIC
37 D EN^DIQ1
38 M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
39 K ^UTILITY("DIQ1",$J)
40 Q
41GBLREF(FILENUM) ; $$(file#) -> global reference
42 I '$G(FILENUM) Q ""
43 Q $$ROOT^DILFD(+FILENUM)
44INDEX(DIK,DA) ; index entry in file - from ORWGAPIP
45 D IX1^DIK
46 Q
47XDEL(ENTITY,PARAM,NAME,ORERR) ; from ORWGAPIP
48 D DEL^XPAR(ENTITY,PARAM,NAME,.ORERR)
49 Q
50XEN(ENTITY,PARAM,NAME,ORVAL,ORERR) ; from ORWGAPIP
51 D EN^XPAR(ENTITY,PARAM,NAME,.ORVAL,.ORERR)
52 Q
53XENVAL(ORVALUES,PARAM) ;
54 D ENVAL^XPAR(.ORVALUES,PARAM)
55 Q
56XGET(ENTITY,PARAM,INST,FORMAT) ; $$(...) -> parameter values
57 Q $$GET^XPAR(ENTITY,PARAM,INST,FORMAT)
58XGETLST(ORLIST,ENTITY,PARAM) ; from ORWGAPIP
59 D GETLST^XPAR(.ORLIST,ENTITY,PARAM)
60 Q
61XGETLST1(ORLIST,ENTITY,PARAM,FORMAT,ORERR) ; from ORWGAPIP
62 D GETLST^XPAR(.ORLIST,ENTITY,PARAM,FORMAT,.ORERR)
63 Q
64XGETWP(ORWP,ENTITY,PARAM,ALL) ; from ORWGAPIP
65 D GETWP^XPAR(.ORWP,ENTITY,PARAM,ALL)
66 Q
67 ; kernel functions
68FMADD(X,D,H,M,S) ;
69 Q $$FMADD^XLFDT(X,$G(D),$G(H),$G(M),$G(S))
70NOW() ;
71 Q $$NOW^XLFDT
72LOW(X) ;
73 Q $$LOW^XLFSTR(X)
74REPLACE(STRING,ORARRAY) ;
75 Q $$REPLACE^XLFSTR(STRING,.ORARRAY)
76TRIM(X,F,V) ;
77 Q $$TRIM^XLFSTR(X,$G(F,"LR"),$G(V," "))
78UP(X) ;
79 Q $$UP^XLFSTR(X)
80INSIG(NODE) ; $$(node) -> sig ; replace INSIG^ORWGAPIA with this code in v27
81 N SIG,SUB,VALUES K VALUES
82 S SUB=$P($G(NODE),";",2)
83 D RXIN^ORWGAPIA(NODE,.VALUES)
84 S SIG=""
85 I SUB=5 D
86 . S SIG=" Give: "_$G(VALUES("MR"))
87 . S SIG=SIG_" "_$P($G(VALUES("SCH",1,0)),U)
88 . S SIG=SIG_" "_$P($G(VALUES("SCH",1,0)),U,2)
89 I SUB="IV" D
90 . S SIG=" Give: "_$G(VALUES("DO"))
91 . S SIG=SIG_" "_$$EXT^ORWGAPIX($G(VALUES("START")),55.01,.02)
92 . S SIG=SIG_" "_$G(VALUES("SCH",1,0))
93 Q SIG
94 ;
95BMIITEMS(ITEMS,CNT,TMP) ; from ORWGAPIR
96 N BMI,NUM,REPLACE K REPLACE
97 S REPLACE("WEIGHT")="BODY MASS INDEX"
98 S BMI=""
99 S NUM=0
100 I 'TMP D
101 . F S NUM=$O(ITEMS(NUM)) Q:NUM<1 D
102 .. I $P(ITEMS(NUM),U,2)=8 S $P(BMI,U)=1
103 .. I $P(ITEMS(NUM),U,2)=9 S $P(BMI,U,2)=ITEMS(NUM)
104 I TMP D
105 . F S NUM=$O(^TMP(ITEMS,$J,NUM)) Q:NUM<1 D
106 .. I $P(^TMP(ITEMS,$J,NUM),U,2)=8 S $P(BMI,U)=1
107 .. I $P(^TMP(ITEMS,$J,NUM),U,2)=9 S $P(BMI,U,2)=^TMP(ITEMS,$J,NUM)
108 I BMI,$L(BMI)>3 D
109 . S CNT=CNT+1
110 . S RESULT=$P(BMI,U,2,99)
111 . S RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE)
112 . S $P(RESULT,U,2)=99999
113 . D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
114 Q
115 ;
116BMIDATA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
117 N DATE,DATE2,NODE,RESULT,VALUE,W K VALUE
118 S DATE="",DATE2="",CNT=$G(CNT)
119 F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE)) Q:DATE="" D
120 . I DATE>START Q
121 . S NODE=""
122 . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE,NODE)) Q:NODE="" D
123 .. D VITAL^ORWGAPIA(.VALUE,NODE) S WT=$P($G(VALUE(7)),U) I 'WT Q
124 .. S BMI=$$BMI(DFN,WT,DATE) I 'BMI Q
125 .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_BMI
126 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
127 Q
128 ;
129BMI(DFN,WT,DATE) ; $$(dfn,wt,date) -> bmi, else ""
130 N HDATE,HT,NEXT,NODE,PREV
131 I '$O(^PXRMINDX(120.5,"PI",DFN,8,0)) Q ""
132 S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,DATE,""))
133 I '$L(NODE) D
134 . S NEXT=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE))
135 . S PREV=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE),-1)
136 . S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,$$CLOSEST(DATE,NEXT,PREV),""))
137 I '$L(NODE) Q ""
138 D VITAL^ORWGAPIA(.VALUE,NODE) S HT=$P($G(VALUE(7)),U) I 'HT Q ""
139 Q $$CALCBMI(HT,WT)
140 ;
141CALCBMI(HT,WT) ; $$(ht,wt) -> bmi uses (inches,lbs)
142 S WT=WT/2.2 ;+$$WEIGHT^XLFMSMT(WT,"LB","KG")
143 S HT=HT*2.54/100 ;+$$LENGTH^XLFMSMT(HT,"IN","M")
144 Q $J(WT/(HT*HT),0,2)
145 ;
146CLOSEST(DATE,NEXT,PREV) ;
147 I $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2) Q PREV
148 Q NEXT
149 ;
150BMILAST(DFN,ARRAY,CNT) ;
151 N BMI,DATE,NUM,WT
152 S (DATE,NUM,WT)=0
153 F S NUM=$O(ARRAY(NUM)) Q:NUM<1 D Q:WT
154 . I $P(ARRAY(NUM),U,2)'="WT" Q
155 . S WT=+$P(ARRAY(NUM),U,3)
156 . S DATE=$P(ARRAY(NUM),U,4)
157 I 'WT Q
158 I 'DATE Q
159 S BMI=$$BMI(DFN,WT,DATE)
160 I 'BMI Q
161 S CNT=CNT+1
162 S ARRAY(CNT)="-1^BMI^"_BMI_U_DATE_U_BMI_"^^"
163 Q
Note: See TracBrowser for help on using the repository browser.