- 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 Jan 18, 2025@03:37:38 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