- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPIX.m
r613 r623 1 ORWGAPIX ; SLC/STAFF - Graph External Calls ;9/29/06 11:49 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242 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 BMIITEMS(ITEMS,CNT,TMP) ; from ORWGAPIR 81 N BMI,NUM,REPLACE K REPLACE 82 S REPLACE("WEIGHT")="BODY MASS INDEX" 83 S BMI="" 84 S NUM=0 85 I 'TMP D 86 . F S NUM=$O(ITEMS(NUM)) Q:NUM<1 D 87 .. I $P(ITEMS(NUM),U,2)=8 S $P(BMI,U)=1 88 .. I $P(ITEMS(NUM),U,2)=9 S $P(BMI,U,2)=ITEMS(NUM) 89 I TMP D 90 . F S NUM=$O(^TMP(ITEMS,$J,NUM)) Q:NUM<1 D 91 .. I $P(^TMP(ITEMS,$J,NUM),U,2)=8 S $P(BMI,U)=1 92 .. I $P(^TMP(ITEMS,$J,NUM),U,2)=9 S $P(BMI,U,2)=^TMP(ITEMS,$J,NUM) 93 I BMI,$L(BMI)>3 D 94 . S CNT=CNT+1 95 . S RESULT=$P(BMI,U,2,99) 96 . S RESULT=$$REPLACE^ORWGAPIX(RESULT,.REPLACE) 97 . S $P(RESULT,U,2)=99999 98 . D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT) 99 Q 100 ; 101 BMIDATA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPI4 102 N DATE,DATE2,NODE,RESULT,VALUE,W K VALUE 103 S DATE="",DATE2="",CNT=$G(CNT) 104 F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE)) Q:DATE="" D 105 . I DATE>START Q 106 . S NODE="" 107 . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,9,DATE,NODE)) Q:NODE="" D 108 .. D VITAL^ORWGAPIA(.VALUE,NODE) S WT=$P($G(VALUE(7)),U) I 'WT Q 109 .. S BMI=$$BMI(DFN,WT,DATE) I 'BMI Q 110 .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_BMI 111 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT) 112 Q 113 ; 114 BMI(DFN,WT,DATE) ; $$(dfn,wt,date) -> bmi, else "" 115 N HDATE,HT,NEXT,NODE,PREV 116 I '$O(^PXRMINDX(120.5,"PI",DFN,8,0)) Q "" 117 S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,DATE,"")) 118 I '$L(NODE) D 119 . S NEXT=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE)) 120 . S PREV=+$O(^PXRMINDX(120.5,"PI",DFN,8,DATE),-1) 121 . S NODE=$O(^PXRMINDX(120.5,"PI",DFN,8,$$CLOSEST(DATE,NEXT,PREV),"")) 122 I '$L(NODE) Q "" 123 D VITAL^ORWGAPIA(.VALUE,NODE) S HT=$P($G(VALUE(7)),U) I 'HT Q "" 124 Q $$CALCBMI(HT,WT) 125 ; 126 CALCBMI(HT,WT) ; $$(ht,wt) -> bmi uses (inches,lbs) 127 S WT=WT/2.2 ;+$$WEIGHT^XLFMSMT(WT,"LB","KG") 128 S HT=HT*2.54/100 ;+$$LENGTH^XLFMSMT(HT,"IN","M") 129 Q $J(WT/(HT*HT),0,2) 130 ; 131 CLOSEST(DATE,NEXT,PREV) ; 132 I $$FMDIFF^XLFDT(DATE,NEXT,2)>$$FMDIFF^XLFDT(DATE,PREV,2) Q PREV 133 Q NEXT 134 ; 135 BMILAST(DFN,ARRAY,CNT) ; 136 N BMI,DATE,NUM,WT 137 S (DATE,NUM,WT)=0 138 F S NUM=$O(ARRAY(NUM)) Q:NUM<1 D Q:WT 139 . I $P(ARRAY(NUM),U,2)'="WT" Q 140 . S WT=+$P(ARRAY(NUM),U,3) 141 . S DATE=$P(ARRAY(NUM),U,4) 142 I 'WT Q 143 I 'DATE Q 144 S BMI=$$BMI(DFN,WT,DATE) 145 I 'BMI Q 146 S CNT=CNT+1 147 S ARRAY(CNT)="-1^BMI^"_BMI_U_DATE_U_BMI_"^^" 148 Q 149 ; 150 ZZ() ; test use only - this code will be removed before v27 release 151 N X,ZIP,ZZ 152 S ZZ=$C(36)_$C(90)_$C(72) 153 S ZIP="S X="_ZZ X ZIP 154 Q X 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
Note:
See TracChangeset
for help on using the changeset viewer.
