ORWGAPIX ; SLC/STAFF - Graph External Calls ;08-Feb-2012 17:39;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243,1010**;Dec 17, 1997;Build 47
;
;Modified - IHS/MSC/MGH - 02/08/2012 - Several changes in BMIITEMS EP, New BMIDATA2 EP
DATE(X) ; $$(date/time) -> date/time
N Y D ^%DT
Q Y
ENDIQ1(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
S NUMDIC=DIC
D EN^DIQ1
M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
K ^UTILITY("DIQ1",$J)
Q
EXT(Y,FILE,FIELD) ; $$(value,file,field) -> external value
N C S C=$P($G(^DD(FILE,FIELD,0)),U,2) D Y^DIQ
Q Y
EXTERNAL(FILE,FIELD,FLAG,VAL) ; $$(file,field,flag,internal value) -> external value
Q $$EXTERNAL^DILFD(FILE,FIELD,FLAG,VAL)
EXTNAME(IEN,FN) ; $$(ien,file#) -> external form of pointer
N REF
S REF=$G(^DIC(FN,0,"GL"))
I $L(REF),+IEN Q $P($G(@(REF_IEN_",0)")),U)
Q ""
FILENM(FILENUM) ; $$(file#) -> file name
N DIC,DO,NAME K DIC,DO
S FILENUM=$$GBLREF(+$G(FILENUM))
I '$L($G(FILENUM)) Q ""
S DIC=FILENUM
D DO^DIC1
S NAME=$P(DO,U)
Q NAME
GETDATA(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
S NUMDIC=DIC
D EN^DIQ1
M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
K ^UTILITY("DIQ1",$J)
Q
GBLREF(FILENUM) ; $$(file#) -> global reference
I '$G(FILENUM) Q ""
Q $$ROOT^DILFD(+FILENUM)
INDEX(DIK,DA) ; index entry in file - from ORWGAPIP
D IX1^DIK
Q
XDEL(ENTITY,PARAM,NAME,ORERR) ; from ORWGAPIP
D DEL^XPAR(ENTITY,PARAM,NAME,.ORERR)
Q
XEN(ENTITY,PARAM,NAME,ORVAL,ORERR) ; from ORWGAPIP
D EN^XPAR(ENTITY,PARAM,NAME,.ORVAL,.ORERR)
Q
XENVAL(ORVALUES,PARAM) ;
D ENVAL^XPAR(.ORVALUES,PARAM)
Q
XGET(ENTITY,PARAM,INST,FORMAT) ; $$(...) -> parameter values
Q $$GET^XPAR(ENTITY,PARAM,INST,FORMAT)
XGETLST(ORLIST,ENTITY,PARAM) ; from ORWGAPIP
D GETLST^XPAR(.ORLIST,ENTITY,PARAM)
Q
XGETLST1(ORLIST,ENTITY,PARAM,FORMAT,ORERR) ; from ORWGAPIP
D GETLST^XPAR(.ORLIST,ENTITY,PARAM,FORMAT,.ORERR)
Q
XGETWP(ORWP,ENTITY,PARAM,ALL) ; from ORWGAPIP
D GETWP^XPAR(.ORWP,ENTITY,PARAM,ALL)
Q
; kernel functions
FMADD(X,D,H,M,S) ;
Q $$FMADD^XLFDT(X,$G(D),$G(H),$G(M),$G(S))
NOW() ;
Q $$NOW^XLFDT
LOW(X) ;
Q $$LOW^XLFSTR(X)
REPLACE(STRING,ORARRAY) ;
Q $$REPLACE^XLFSTR(STRING,.ORARRAY)
TRIM(X,F,V) ;
Q $$TRIM^XLFSTR(X,$G(F,"LR"),$G(V," "))
UP(X) ;
Q $$UP^XLFSTR(X)
BMIITEMS(ITEMS,CNT,TMP) ; from ORWGAPIR
N BMI,NUM,REPLACE,HT,WT K REPLACE
S BMI=""
S NUM=0
;IHS/MSC/MGH added lookup for V measurements
I +$$GET^XPAR("ALL","BEHOVM USE VMSR") D
.S HT=$O(^AUTTMSR("B","HT",""))
.Q:HT=""
.S WT=$O(^AUTTMSR("B","WT",""))
.Q:WT=""
.S REPLACE("WT")="BMI"
E D
.S HT=8 S WT=9
.S REPLACE("WEIGHT")="BODY MASS INDEX"
I 'TMP D
. F S NUM=$O(ITEMS(NUM)) Q:NUM<1 D
.. I $P(ITEMS(NUM),U,2)=HT S $P(BMI,U)=1
.. I $P(ITEMS(NUM),U,2)=WT S $P(BMI,U,2)=ITEMS(NUM)
I TMP D
. F S NUM=$O(^TMP(ITEMS,$J,NUM)) Q:NUM<1 D
.. I $P(^TMP(ITEMS,$J,NUM),U,2)=HT S $P(BMI,U)=1
.. I $P(^TMP(ITEMS,$J,NUM),U,2)=WT S $P(BMI,U,2)=^TMP(ITEMS,$J,NUM)
I BMI,$L(BMI)>3 D
. S CNT=CNT+1
. S RESULT=$P(BMI,U,2,99)
. S RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE)
. S $P(RESULT,U,2)=99999
. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
Q
;
BMIDATA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
N DATE,DATE2,NODE,RESULT,VALUE,W K VALUE
S DATE="",DATE2="",CNT=$G(CNT)
F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE)) Q:DATE="" D
. I DATE>START Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE,NODE)) Q:NODE="" D
.. D VITAL^ORWGAPIA(.VALUE,NODE) S WT=$P($G(VALUE(7)),U) I 'WT Q
.. S BMI=$$BMI(DFN,WT,DATE) I 'BMI Q
.. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_BMI
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
;IHS/MSC/MGH Added BMI lookup for V measurements
BMIDATA2(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
N DATE,DATE2,NODE,RESULT,VALUE,W K VALUE
N WTIEN
S WTIEN=$O(^AUTTMSR("B","WT",""))
Q:WTIEN=""
S DATE="",DATE2="",CNT=$G(CNT)
F S DATE=$O(^PXRMINDX(9000010.01,"PI",DFN,WTIEN,DATE)) Q:DATE="" D
. I DATE>START Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.01,"PI",DFN,WTIEN,DATE,NODE)) Q:NODE="" D
.. D MEAS^ORWGAPIA(.VALUE,NODE) S WT=$P($G(VALUE(7)),U) I 'WT Q
.. S BMI=$$BMI^APCHS2A3(DFN,WT,DATE)
.. S BMI=$TR($P(BMI,U,1)," ","") I 'BMI Q
.. S RESULT=9000010.01_U_ITEM_U_DATE_U_DATE2_U_BMI
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
BMI(DFN,WT,DATE) ; $$(dfn,wt,date) -> bmi, else ""
N HDATE,HT,NEXT,NODE,PREV
I '$O(^PXRMINDX(120.5,"PI",DFN,8,0)) Q ""
S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,DATE,""))
I '$L(NODE) D
. S NEXT=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE))
. S PREV=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE),-1)
. S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,$$CLOSEST(DATE,NEXT,PREV),""))
I '$L(NODE) Q ""
D VITAL^ORWGAPIA(.VALUE,NODE) S HT=$P($G(VALUE(7)),U) I 'HT Q ""
Q $$CALCBMI(HT,WT)
;
CALCBMI(HT,WT) ; $$(ht,wt) -> bmi uses (inches,lbs)
S WT=WT/2.2 ;+$$WEIGHT^XLFMSMT(WT,"LB","KG")
S HT=HT*2.54/100 ;+$$LENGTH^XLFMSMT(HT,"IN","M")
Q $J(WT/(HT*HT),0,2)
;
CLOSEST(DATE,NEXT,PREV) ;
I $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2) Q PREV
Q NEXT
;
BMILAST(DFN,ARRAY,CNT) ;
N BMI,DATE,NUM,WT
S (DATE,NUM,WT)=0
F S NUM=$O(ARRAY(NUM)) Q:NUM<1 D Q:WT
. I $P(ARRAY(NUM),U,2)'="WT" Q
. S WT=+$P(ARRAY(NUM),U,3)
. S DATE=$P(ARRAY(NUM),U,4)
I 'WT Q
I 'DATE Q
S BMI=$$BMI(DFN,WT,DATE)
I 'BMI Q
S CNT=CNT+1
S ARRAY(CNT)="-1^BMI^"_BMI_U_DATE_U_BMI_"^^"
Q
;
ZZ() ; test use only - this code will be removed before v27 release
N X,ZIP,ZZ
S ZZ=$C(36)_$C(90)_$C(72)
S ZIP="S X="_ZZ X ZIP
Q X
ORWGAPIX ; SLC/STAFF - Graph External Calls ;08-Feb-2012 17:39;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243,1010**;Dec 17, 1997;Build 47
+2 ;
+3 ;Modified - IHS/MSC/MGH - 02/08/2012 - Several changes in BMIITEMS EP, New BMIDATA2 EP
DATE(X) ; $$(date/time) -> date/time
+1 NEW Y
DO ^%DT
+2 QUIT Y
ENDIQ1(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
+1 NEW NUMDIC
KILL RESULTS,^UTILITY("DIQ1",$JOB)
+2 IF '$GET(DIC)
QUIT
IF '$LENGTH(DR)
QUIT
IF '$GET(DA)
QUIT
+3 SET NUMDIC=DIC
+4 DO EN^DIQ1
+5 MERGE RESULTS=^UTILITY("DIQ1",$JOB,NUMDIC,DA)
+6 KILL ^UTILITY("DIQ1",$JOB)
+7 QUIT
EXT(Y,FILE,FIELD) ; $$(value,file,field) -> external value
+1 NEW C
SET C=$PIECE($GET(^DD(FILE,FIELD,0)),U,2)
DO Y^DIQ
+2 QUIT Y
EXTERNAL(FILE,FIELD,FLAG,VAL) ; $$(file,field,flag,internal value) -> external value
+1 QUIT $$EXTERNAL^DILFD(FILE,FIELD,FLAG,VAL)
EXTNAME(IEN,FN) ; $$(ien,file#) -> external form of pointer
+1 NEW REF
+2 SET REF=$GET(^DIC(FN,0,"GL"))
+3 IF $LENGTH(REF)
IF +IEN
QUIT $PIECE($GET(@(REF_IEN_",0)")),U)
+4 QUIT ""
FILENM(FILENUM) ; $$(file#) -> file name
+1 NEW DIC,DO,NAME
KILL DIC,DO
+2 SET FILENUM=$$GBLREF(+$GET(FILENUM))
+3 IF '$LENGTH($GET(FILENUM))
QUIT ""
+4 SET DIC=FILENUM
+5 DO DO^DIC1
+6 SET NAME=$PIECE(DO,U)
+7 QUIT NAME
GETDATA(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
+1 NEW NUMDIC
KILL RESULTS,^UTILITY("DIQ1",$JOB)
+2 IF '$GET(DIC)
QUIT
IF '$LENGTH(DR)
QUIT
IF '$GET(DA)
QUIT
+3 SET NUMDIC=DIC
+4 DO EN^DIQ1
+5 MERGE RESULTS=^UTILITY("DIQ1",$JOB,NUMDIC,DA)
+6 KILL ^UTILITY("DIQ1",$JOB)
+7 QUIT
GBLREF(FILENUM) ; $$(file#) -> global reference
+1 IF '$GET(FILENUM)
QUIT ""
+2 QUIT $$ROOT^DILFD(+FILENUM)
INDEX(DIK,DA) ; index entry in file - from ORWGAPIP
+1 DO IX1^DIK
+2 QUIT
XDEL(ENTITY,PARAM,NAME,ORERR) ; from ORWGAPIP
+1 DO DEL^XPAR(ENTITY,PARAM,NAME,.ORERR)
+2 QUIT
XEN(ENTITY,PARAM,NAME,ORVAL,ORERR) ; from ORWGAPIP
+1 DO EN^XPAR(ENTITY,PARAM,NAME,.ORVAL,.ORERR)
+2 QUIT
XENVAL(ORVALUES,PARAM) ;
+1 DO ENVAL^XPAR(.ORVALUES,PARAM)
+2 QUIT
XGET(ENTITY,PARAM,INST,FORMAT) ; $$(...) -> parameter values
+1 QUIT $$GET^XPAR(ENTITY,PARAM,INST,FORMAT)
XGETLST(ORLIST,ENTITY,PARAM) ; from ORWGAPIP
+1 DO GETLST^XPAR(.ORLIST,ENTITY,PARAM)
+2 QUIT
XGETLST1(ORLIST,ENTITY,PARAM,FORMAT,ORERR) ; from ORWGAPIP
+1 DO GETLST^XPAR(.ORLIST,ENTITY,PARAM,FORMAT,.ORERR)
+2 QUIT
XGETWP(ORWP,ENTITY,PARAM,ALL) ; from ORWGAPIP
+1 DO GETWP^XPAR(.ORWP,ENTITY,PARAM,ALL)
+2 QUIT
+3 ; kernel functions
FMADD(X,D,H,M,S) ;
+1 QUIT $$FMADD^XLFDT(X,$GET(D),$GET(H),$GET(M),$GET(S))
NOW() ;
+1 QUIT $$NOW^XLFDT
LOW(X) ;
+1 QUIT $$LOW^XLFSTR(X)
REPLACE(STRING,ORARRAY) ;
+1 QUIT $$REPLACE^XLFSTR(STRING,.ORARRAY)
TRIM(X,F,V) ;
+1 QUIT $$TRIM^XLFSTR(X,$GET(F,"LR"),$GET(V," "))
UP(X) ;
+1 QUIT $$UP^XLFSTR(X)
BMIITEMS(ITEMS,CNT,TMP) ; from ORWGAPIR
+1 NEW BMI,NUM,REPLACE,HT,WT
KILL REPLACE
+2 SET BMI=""
+3 SET NUM=0
+4 ;IHS/MSC/MGH added lookup for V measurements
+5 IF +$$GET^XPAR("ALL","BEHOVM USE VMSR")
Begin DoDot:1
+6 SET HT=$ORDER(^AUTTMSR("B","HT",""))
+7 IF HT=""
QUIT
+8 SET WT=$ORDER(^AUTTMSR("B","WT",""))
+9 IF WT=""
QUIT
+10 SET REPLACE("WT")="BMI"
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET HT=8
SET WT=9
+13 SET REPLACE("WEIGHT")="BODY MASS INDEX"
End DoDot:1
+14 IF 'TMP
Begin DoDot:1
+15 FOR
SET NUM=$ORDER(ITEMS(NUM))
IF NUM<1
QUIT
Begin DoDot:2
+16 IF $PIECE(ITEMS(NUM),U,2)=HT
SET $PIECE(BMI,U)=1
+17 IF $PIECE(ITEMS(NUM),U,2)=WT
SET $PIECE(BMI,U,2)=ITEMS(NUM)
End DoDot:2
End DoDot:1
+18 IF TMP
Begin DoDot:1
+19 FOR
SET NUM=$ORDER(^TMP(ITEMS,$JOB,NUM))
IF NUM<1
QUIT
Begin DoDot:2
+20 IF $PIECE(^TMP(ITEMS,$JOB,NUM),U,2)=HT
SET $PIECE(BMI,U)=1
+21 IF $PIECE(^TMP(ITEMS,$JOB,NUM),U,2)=WT
SET $PIECE(BMI,U,2)=^TMP(ITEMS,$JOB,NUM)
End DoDot:2
End DoDot:1
+22 IF BMI
IF $LENGTH(BMI)>3
Begin DoDot:1
+23 SET CNT=CNT+1
+24 SET RESULT=$PIECE(BMI,U,2,99)
+25 SET RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE)
+26 SET $PIECE(RESULT,U,2)=99999
+27 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+28 QUIT
+29 ;
BMIDATA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,W
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(120.5,"PI",DFN,9,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 SET NODE=""
+6 FOR
SET NODE=$ORDER(^PXRMINDX(120.5,"PI",DFN,9,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+7 DO VITAL^ORWGAPIA(.VALUE,NODE)
SET WT=$PIECE($GET(VALUE(7)),U)
IF 'WT
QUIT
+8 SET BMI=$$BMI(DFN,WT,DATE)
IF 'BMI
QUIT
+9 SET RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_BMI
+10 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;IHS/MSC/MGH Added BMI lookup for V measurements
BMIDATA2(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,W
KILL VALUE
+2 NEW WTIEN
+3 SET WTIEN=$ORDER(^AUTTMSR("B","WT",""))
+4 IF WTIEN=""
QUIT
+5 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
+6 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.01,"PI",DFN,WTIEN,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+7 IF DATE>START
QUIT
+8 SET NODE=""
+9 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.01,"PI",DFN,WTIEN,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+10 DO MEAS^ORWGAPIA(.VALUE,NODE)
SET WT=$PIECE($GET(VALUE(7)),U)
IF 'WT
QUIT
+11 SET BMI=$$BMI^APCHS2A3(DFN,WT,DATE)
+12 SET BMI=$TRANSLATE($PIECE(BMI,U,1)," ","")
IF 'BMI
QUIT
+13 SET RESULT=9000010.01_U_ITEM_U_DATE_U_DATE2_U_BMI
+14 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+15 QUIT
BMI(DFN,WT,DATE) ; $$(dfn,wt,date) -> bmi, else ""
+1 NEW HDATE,HT,NEXT,NODE,PREV
+2 IF '$ORDER(^PXRMINDX(120.5,"PI",DFN,8,0))
QUIT ""
+3 SET NODE=$ORDER(^PXRMINDX(120.5,"PI",DFN,8,DATE,""))
+4 IF '$LENGTH(NODE)
Begin DoDot:1
+5 SET NEXT=+$ORDER(^PXRMINDX(120.5,"PI",DFN,8,DATE))
+6 SET PREV=+$ORDER(^PXRMINDX(120.5,"PI",DFN,8,DATE),-1)
+7 SET NODE=$ORDER(^PXRMINDX(120.5,"PI",DFN,8,$$CLOSEST(DATE,NEXT,PREV),""))
End DoDot:1
+8 IF '$LENGTH(NODE)
QUIT ""
+9 DO VITAL^ORWGAPIA(.VALUE,NODE)
SET HT=$PIECE($GET(VALUE(7)),U)
IF 'HT
QUIT ""
+10 QUIT $$CALCBMI(HT,WT)
+11 ;
CALCBMI(HT,WT) ; $$(ht,wt) -> bmi uses (inches,lbs)
+1 ;+$$WEIGHT^XLFMSMT(WT,"LB","KG")
SET WT=WT/2.2
+2 ;+$$LENGTH^XLFMSMT(HT,"IN","M")
SET HT=HT*2.54/100
+3 QUIT $JUSTIFY(WT/(HT*HT),0,2)
+4 ;
CLOSEST(DATE,NEXT,PREV) ;
+1 IF $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2)
QUIT PREV
+2 QUIT NEXT
+3 ;
BMILAST(DFN,ARRAY,CNT) ;
+1 NEW BMI,DATE,NUM,WT
+2 SET (DATE,NUM,WT)=0
+3 FOR
SET NUM=$ORDER(ARRAY(NUM))
IF NUM<1
QUIT
Begin DoDot:1
+4 IF $PIECE(ARRAY(NUM),U,2)'="WT"
QUIT
+5 SET WT=+$PIECE(ARRAY(NUM),U,3)
+6 SET DATE=$PIECE(ARRAY(NUM),U,4)
End DoDot:1
IF WT
QUIT
+7 IF 'WT
QUIT
+8 IF 'DATE
QUIT
+9 SET BMI=$$BMI(DFN,WT,DATE)
+10 IF 'BMI
QUIT
+11 SET CNT=CNT+1
+12 SET ARRAY(CNT)="-1^BMI^"_BMI_U_DATE_U_BMI_"^^"
+13 QUIT
+14 ;
ZZ() ; test use only - this code will be removed before v27 release
+1 NEW X,ZIP,ZZ
+2 SET ZZ=$CHAR(36)_$CHAR(90)_$CHAR(72)
+3 SET ZIP="S X="_ZZ
XECUTE ZIP
+4 QUIT X
