Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWGAPIX

ORWGAPIX.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. DATE(X) ; $$(date/time) -> date/time
  1. N Y D ^%DT
  1. Q Y
  1. ENDIQ1(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
  1. N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
  1. Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
  1. S NUMDIC=DIC
  1. D EN^DIQ1
  1. M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
  1. K ^UTILITY("DIQ1",$J)
  1. Q
  1. EXT(Y,FILE,FIELD) ; $$(value,file,field) -> external value
  1. N C S C=$P($G(^DD(FILE,FIELD,0)),U,2) D Y^DIQ
  1. Q Y
  1. EXTERNAL(FILE,FIELD,FLAG,VAL) ; $$(file,field,flag,internal value) -> external value
  1. Q $$EXTERNAL^DILFD(FILE,FIELD,FLAG,VAL)
  1. EXTNAME(IEN,FN) ; $$(ien,file#) -> external form of pointer
  1. N REF
  1. S REF=$G(^DIC(FN,0,"GL"))
  1. I $L(REF),+IEN Q $P($G(@(REF_IEN_",0)")),U)
  1. Q ""
  1. FILENM(FILENUM) ; $$(file#) -> file name
  1. N DIC,DO,NAME K DIC,DO
  1. S FILENUM=$$GBLREF(+$G(FILENUM))
  1. I '$L($G(FILENUM)) Q ""
  1. S DIC=FILENUM
  1. D DO^DIC1
  1. S NAME=$P(DO,U)
  1. Q NAME
  1. GETDATA(RESULTS,DIC,DR,DA,DIQ) ; use file # for DIC
  1. N NUMDIC K RESULTS,^UTILITY("DIQ1",$J)
  1. Q:'$G(DIC) Q:'$L(DR) Q:'$G(DA)
  1. S NUMDIC=DIC
  1. D EN^DIQ1
  1. M RESULTS=^UTILITY("DIQ1",$J,NUMDIC,DA)
  1. K ^UTILITY("DIQ1",$J)
  1. Q
  1. GBLREF(FILENUM) ; $$(file#) -> global reference
  1. I '$G(FILENUM) Q ""
  1. Q $$ROOT^DILFD(+FILENUM)
  1. INDEX(DIK,DA) ; index entry in file - from ORWGAPIP
  1. D IX1^DIK
  1. Q
  1. XDEL(ENTITY,PARAM,NAME,ORERR) ; from ORWGAPIP
  1. D DEL^XPAR(ENTITY,PARAM,NAME,.ORERR)
  1. Q
  1. XEN(ENTITY,PARAM,NAME,ORVAL,ORERR) ; from ORWGAPIP
  1. D EN^XPAR(ENTITY,PARAM,NAME,.ORVAL,.ORERR)
  1. Q
  1. XENVAL(ORVALUES,PARAM) ;
  1. D ENVAL^XPAR(.ORVALUES,PARAM)
  1. Q
  1. XGET(ENTITY,PARAM,INST,FORMAT) ; $$(...) -> parameter values
  1. Q $$GET^XPAR(ENTITY,PARAM,INST,FORMAT)
  1. XGETLST(ORLIST,ENTITY,PARAM) ; from ORWGAPIP
  1. D GETLST^XPAR(.ORLIST,ENTITY,PARAM)
  1. Q
  1. XGETLST1(ORLIST,ENTITY,PARAM,FORMAT,ORERR) ; from ORWGAPIP
  1. D GETLST^XPAR(.ORLIST,ENTITY,PARAM,FORMAT,.ORERR)
  1. Q
  1. XGETWP(ORWP,ENTITY,PARAM,ALL) ; from ORWGAPIP
  1. D GETWP^XPAR(.ORWP,ENTITY,PARAM,ALL)
  1. Q
  1. ; kernel functions
  1. FMADD(X,D,H,M,S) ;
  1. Q $$FMADD^XLFDT(X,$G(D),$G(H),$G(M),$G(S))
  1. NOW() ;
  1. Q $$NOW^XLFDT
  1. LOW(X) ;
  1. Q $$LOW^XLFSTR(X)
  1. REPLACE(STRING,ORARRAY) ;
  1. Q $$REPLACE^XLFSTR(STRING,.ORARRAY)
  1. TRIM(X,F,V) ;
  1. Q $$TRIM^XLFSTR(X,$G(F,"LR"),$G(V," "))
  1. UP(X) ;
  1. Q $$UP^XLFSTR(X)
  1. BMIITEMS(ITEMS,CNT,TMP) ; from ORWGAPIR
  1. N BMI,NUM,REPLACE K REPLACE
  1. S REPLACE("WEIGHT")="BODY MASS INDEX"
  1. S BMI=""
  1. S NUM=0
  1. I 'TMP D
  1. . F S NUM=$O(ITEMS(NUM)) Q:NUM<1 D
  1. .. I $P(ITEMS(NUM),U,2)=8 S $P(BMI,U)=1
  1. .. I $P(ITEMS(NUM),U,2)=9 S $P(BMI,U,2)=ITEMS(NUM)
  1. I TMP D
  1. . F S NUM=$O(^TMP(ITEMS,$J,NUM)) Q:NUM<1 D
  1. .. I $P(^TMP(ITEMS,$J,NUM),U,2)=8 S $P(BMI,U)=1
  1. .. I $P(^TMP(ITEMS,$J,NUM),U,2)=9 S $P(BMI,U,2)=^TMP(ITEMS,$J,NUM)
  1. I BMI,$L(BMI)>3 D
  1. . S CNT=CNT+1
  1. . S RESULT=$P(BMI,U,2,99)
  1. . S RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE)
  1. . S $P(RESULT,U,2)=99999
  1. . D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. BMIDATA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4
  1. N DATE,DATE2,NODE,RESULT,VALUE,W K VALUE
  1. S DATE="",DATE2="",CNT=$G(CNT)
  1. F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE)) Q:DATE="" D
  1. . I DATE>START Q
  1. . S NODE=""
  1. . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE,NODE)) Q:NODE="" D
  1. .. D VITAL^ORWGAPIA(.VALUE,NODE) S WT=$P($G(VALUE(7)),U) I 'WT Q
  1. .. S BMI=$$BMI(DFN,WT,DATE) I 'BMI Q
  1. .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_BMI
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. BMI(DFN,WT,DATE) ; $$(dfn,wt,date) -> bmi, else ""
  1. N HDATE,HT,NEXT,NODE,PREV
  1. I '$O(^PXRMINDX(120.5,"PI",DFN,8,0)) Q ""
  1. S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,DATE,""))
  1. I '$L(NODE) D
  1. . S NEXT=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE))
  1. . S PREV=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE),-1)
  1. . S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,$$CLOSEST(DATE,NEXT,PREV),""))
  1. I '$L(NODE) Q ""
  1. D VITAL^ORWGAPIA(.VALUE,NODE) S HT=$P($G(VALUE(7)),U) I 'HT Q ""
  1. Q $$CALCBMI(HT,WT)
  1. ;
  1. CALCBMI(HT,WT) ; $$(ht,wt) -> bmi uses (inches,lbs)
  1. S WT=WT/2.2 ;+$$WEIGHT^XLFMSMT(WT,"LB","KG")
  1. S HT=HT*2.54/100 ;+$$LENGTH^XLFMSMT(HT,"IN","M")
  1. Q $J(WT/(HT*HT),0,2)
  1. ;
  1. CLOSEST(DATE,NEXT,PREV) ;
  1. I $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2) Q PREV
  1. Q NEXT
  1. ;
  1. BMILAST(DFN,ARRAY,CNT) ;
  1. N BMI,DATE,NUM,WT
  1. S (DATE,NUM,WT)=0
  1. F S NUM=$O(ARRAY(NUM)) Q:NUM<1 D Q:WT
  1. . I $P(ARRAY(NUM),U,2)'="WT" Q
  1. . S WT=+$P(ARRAY(NUM),U,3)
  1. . S DATE=$P(ARRAY(NUM),U,4)
  1. I 'WT Q
  1. I 'DATE Q
  1. S BMI=$$BMI(DFN,WT,DATE)
  1. I 'BMI Q
  1. S CNT=CNT+1
  1. S ARRAY(CNT)="-1^BMI^"_BMI_U_DATE_U_BMI_"^^"
  1. Q
  1. ;
  1. ZZ() ; test use only - this code will be removed before v27 release
  1. N X,ZIP,ZZ
  1. S ZZ=$C(36)_$C(90)_$C(72)
  1. S ZIP="S X="_ZZ X ZIP
  1. Q X