| 1 | ORWGAPIX ; 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 |  ;
 | 
|---|
| 4 | DATE(X) ; $$(date/time) -> date/time
 | 
|---|
| 5 |  N Y D ^%DT
 | 
|---|
| 6 |  Q Y
 | 
|---|
| 7 | ENDIQ1(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
 | 
|---|
| 15 | EXT(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
 | 
|---|
| 18 | EXTERNAL(FILE,FIELD,FLAG,VAL) ; $$(file,field,flag,internal value) -> external value
 | 
|---|
| 19 |  Q $$EXTERNAL^DILFD(FILE,FIELD,FLAG,VAL)
 | 
|---|
| 20 | EXTNAME(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 ""
 | 
|---|
| 25 | FILENM(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
 | 
|---|
| 33 | GETDATA(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
 | 
|---|
| 41 | GBLREF(FILENUM) ; $$(file#) -> global reference
 | 
|---|
| 42 |  I '$G(FILENUM) Q ""
 | 
|---|
| 43 |  Q $$ROOT^DILFD(+FILENUM)
 | 
|---|
| 44 | INDEX(DIK,DA) ; index entry in file   -  from ORWGAPIP
 | 
|---|
| 45 |  D IX1^DIK
 | 
|---|
| 46 |  Q
 | 
|---|
| 47 | XDEL(ENTITY,PARAM,NAME,ORERR) ; from ORWGAPIP
 | 
|---|
| 48 |  D DEL^XPAR(ENTITY,PARAM,NAME,.ORERR)
 | 
|---|
| 49 |  Q
 | 
|---|
| 50 | XEN(ENTITY,PARAM,NAME,ORVAL,ORERR) ; from ORWGAPIP
 | 
|---|
| 51 |  D EN^XPAR(ENTITY,PARAM,NAME,.ORVAL,.ORERR)
 | 
|---|
| 52 |  Q
 | 
|---|
| 53 | XENVAL(ORVALUES,PARAM) ;
 | 
|---|
| 54 |  D ENVAL^XPAR(.ORVALUES,PARAM)
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 | XGET(ENTITY,PARAM,INST,FORMAT) ; $$(...) -> parameter values
 | 
|---|
| 57 |  Q $$GET^XPAR(ENTITY,PARAM,INST,FORMAT)
 | 
|---|
| 58 | XGETLST(ORLIST,ENTITY,PARAM) ; from ORWGAPIP
 | 
|---|
| 59 |  D GETLST^XPAR(.ORLIST,ENTITY,PARAM)
 | 
|---|
| 60 |  Q
 | 
|---|
| 61 | XGETLST1(ORLIST,ENTITY,PARAM,FORMAT,ORERR) ; from ORWGAPIP
 | 
|---|
| 62 |  D GETLST^XPAR(.ORLIST,ENTITY,PARAM,FORMAT,.ORERR)
 | 
|---|
| 63 |  Q
 | 
|---|
| 64 | XGETWP(ORWP,ENTITY,PARAM,ALL) ; from ORWGAPIP
 | 
|---|
| 65 |  D GETWP^XPAR(.ORWP,ENTITY,PARAM,ALL)
 | 
|---|
| 66 |  Q
 | 
|---|
| 67 |  ; kernel functions
 | 
|---|
| 68 | FMADD(X,D,H,M,S) ;
 | 
|---|
| 69 |  Q $$FMADD^XLFDT(X,$G(D),$G(H),$G(M),$G(S))
 | 
|---|
| 70 | NOW() ;
 | 
|---|
| 71 |  Q $$NOW^XLFDT
 | 
|---|
| 72 | LOW(X) ;
 | 
|---|
| 73 |  Q $$LOW^XLFSTR(X)
 | 
|---|
| 74 | REPLACE(STRING,ORARRAY) ;
 | 
|---|
| 75 |  Q $$REPLACE^XLFSTR(STRING,.ORARRAY)
 | 
|---|
| 76 | TRIM(X,F,V) ;
 | 
|---|
| 77 |  Q $$TRIM^XLFSTR(X,$G(F,"LR"),$G(V," "))
 | 
|---|
| 78 | UP(X) ;
 | 
|---|
| 79 |  Q $$UP^XLFSTR(X)
 | 
|---|
| 80 | INSIG(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 |  ;
 | 
|---|
| 95 | BMIITEMS(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 |  ;
 | 
|---|
| 116 | BMIDATA(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 |  ;
 | 
|---|
| 129 | BMI(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 |  ;
 | 
|---|
| 141 | CALCBMI(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 |  ;
 | 
|---|
| 146 | CLOSEST(DATE,NEXT,PREV) ;
 | 
|---|
| 147 |  I $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2) Q PREV
 | 
|---|
| 148 |  Q NEXT
 | 
|---|
| 149 |  ;
 | 
|---|
| 150 | BMILAST(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
 | 
|---|