ORWGAPIX ; SLC/STAFF - Graph External Calls ;9/29/06 11:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
;
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 K REPLACE
S REPLACE("WEIGHT")="BODY MASS INDEX"
S BMI=""
S NUM=0
I 'TMP D
. F S NUM=$O(ITEMS(NUM)) Q:NUM<1 D
.. I $P(ITEMS(NUM),U,2)=8 S $P(BMI,U)=1
.. I $P(ITEMS(NUM),U,2)=9 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)=8 S $P(BMI,U)=1
.. I $P(^TMP(ITEMS,$J,NUM),U,2)=9 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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPIX 4712 printed Apr 09, 2024@21:44 Page 2
ORWGAPIX ; SLC/STAFF - Graph External Calls ;9/29/06 11:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
+2 ;
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
KILL REPLACE
+2 SET REPLACE("WEIGHT")="BODY MASS INDEX"
+3 SET BMI=""
+4 SET NUM=0
+5 IF 'TMP
Begin DoDot:1
+6 FOR
SET NUM=$ORDER(ITEMS(NUM))
if NUM<1
QUIT
Begin DoDot:2
+7 IF $PIECE(ITEMS(NUM),U,2)=8
SET $PIECE(BMI,U)=1
+8 IF $PIECE(ITEMS(NUM),U,2)=9
SET $PIECE(BMI,U,2)=ITEMS(NUM)
End DoDot:2
End DoDot:1
+9 IF TMP
Begin DoDot:1
+10 FOR
SET NUM=$ORDER(^TMP(ITEMS,$JOB,NUM))
if NUM<1
QUIT
Begin DoDot:2
+11 IF $PIECE(^TMP(ITEMS,$JOB,NUM),U,2)=8
SET $PIECE(BMI,U)=1
+12 IF $PIECE(^TMP(ITEMS,$JOB,NUM),U,2)=9
SET $PIECE(BMI,U,2)=^TMP(ITEMS,$JOB,NUM)
End DoDot:2
End DoDot:1
+13 IF BMI
IF $LENGTH(BMI)>3
Begin DoDot:1
+14 SET CNT=CNT+1
+15 SET RESULT=$PIECE(BMI,U,2,99)
+16 SET RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE)
+17 SET $PIECE(RESULT,U,2)=99999
+18 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:1
+19 QUIT
+20 ;
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 ;
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
