Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP4V.m

    r613 r623  
    1 ORWRP4V ; slc/dcm - OE/RR HDR Report Extract RPC's Vitals;9/21/05  13:21
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
    3 VS      ;Vitals code for HDR
    4         N I,IFN,IFN1,IFN2,X,X1,X2,X4,X5,XIFN,ORX,COL,CODE,I1,CNT,%DT,FAC,FACU,NODE,QUALIF,METHOD,UNIT
    5         K ^TMP("ORXS",$J)
    6         S IFN=""
    7         F  S IFN=$O(^XTMP(HANDLE,"D",IFN)) Q:IFN=""  S XIFN=^(IFN) D
    8         . S X11=$P(XIFN,"^",11),X12=$P(XIFN,"^",12),X2=$P(XIFN,"^",2),FACU=X12
    9         . I X12="",X11,X11'=200 S FACU=$O(^DIC(4,"D",X11,0)) I FACU S FACU=$P(^DIC(4,FACU,0),"^")
    10         . I '$L(FACU) S FACU=$S($L($P(XIFN,"^",2)):$P(XIFN,"^",2),1:"Unknown")
    11         . S $P(XIFN,"^",2)=FACU,X4=$P($P(XIFN,"^",4),":",1,2),X5=$P($P(XIFN,"^",5),"~",2)
    12         . I $P(XIFN,"^",10)'="W",$L(X5) D
    13         .. S X4=9999999-$$SETDATE^ORWRP4(X4)
    14         .. I X4=9999999 F I=.01:.01 S X4=X4+I I '$D(^TMP("ORXS",$J,FACU,X4)) Q
    15         .. S ^TMP("ORXS",$J,FACU,X4)=$P(XIFN,"^",2),^TMP("ORXS",$J,FACU,X4,X5,IFN)=XIFN
    16         K ^TMP("ORXS1",$J),^TMP("ORXS2",$J)
    17         S FAC="",CNT=-1
    18         F  S FAC=$O(^TMP("ORXS",$J,FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS",$J,FAC,IFN)) Q:IFN=""  S NODE=^(IFN) D
    19         . D XVSET("1^"_$P(NODE,"^"),1,FAC,IFN,NODE) ;Facility
    20         . I $P(IFN,".")'=9999999 D XVSET("2^"_$$DATE^ORDVU(9999999-IFN),2,FAC,IFN,NODE) ; Measurement Date/Time
    21         . I $P(IFN,".")=9999999 D XVSET("2^"_" ",2,FAC,IFN,NODE) ; Measurement Date/Time = ""
    22         . S IFN1=""
    23         . F  S IFN1=$O(^TMP("ORXS",$J,FAC,IFN,IFN1)) Q:IFN1=""  S IFN2="" F  S IFN2=$O(^TMP("ORXS",$J,FAC,IFN,IFN1,IFN2)) Q:IFN2=""  S X=^(IFN2) D
    24         .. I $$UPPER^ORU(IFN1)="TEMPERATURE" D XVSET("3^"_$P(X,"^",6),3,FAC,IFN,X) D METH(X)
    25         .. I $$UPPER^ORU(IFN1)="PULSE" D XVSET("4^"_$P(X,"^",6),4,FAC,IFN,X) D METH(X)
    26         .. I $$UPPER^ORU(IFN1)="RESPIRATION" D XVSET("5^"_$P(X,"^",6),5,FAC,IFN,X) D METH(X)
    27         .. I $$UPPER^ORU(IFN1)="BLOOD PRESSURE" D XVSET("6^"_$P(X,"^",6),6,FAC,IFN,X) D METH(X)
    28         .. I $$UPPER^ORU(IFN1)="HEIGHT" D XVSET("7^"_$P(X,"^",6),7,FAC,IFN,X) D METH(X)
    29         .. I $$UPPER^ORU(IFN1)="WEIGHT" D XVSET("8^"_$P(X,"^",6),8,FAC,IFN,X) D METH(X)
    30         .. I $$UPPER^ORU(IFN1)="PAIN" D XVSET("9^"_$P(X,"^",6),9,FAC,IFN,X) D METH(X)
    31         .. I $$UPPER^ORU(IFN1)="PULSE OXIMETRY" D
    32         ... D XVSET("10^"_$P(X,"^",6),10,FAC,IFN,X) D METH(X)
    33         ... F I=1:1:2 D
    34         .... I $L($P(X,"^",13)),$P($P($P(X,"^",13),"|",I)," ",2)["l/min" D XVSET("13^"_$P($P($P(X,"^",13),"|",I)," "),13,FAC,IFN,X) ;Flow Rate
    35         .... I $L($P(X,"^",13)),$P($P($P(X,"^",13),"|",I)," ",2)["%" D XVSET("14^"_$P($P($P(X,"^",13),"|",I)," "),14,FAC,IFN,X) ;O2 Concentration
    36         .. I $$UPPER^ORU(IFN1)="CENTRAL VENOUS PRESSURE" D XVSET("11^"_$P(X,"^",6),11,FAC,IFN,X) D METH(X)
    37         .. I $$UPPER^ORU(IFN1)="CIRCUMFERENCE/GIRTH" D XVSET("12^"_$P(X,"^",6),12,FAC,IFN,X) D METH(X)
    38         S FAC=""
    39         F  S FAC=$O(^TMP("ORXS2",$J,"METH",FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS2",$J,"METH",FAC,IFN)) Q:IFN=""  S METHOD=^(IFN,1),DATA=^(0) D
    40         .I $L(METHOD) S X=METHOD D
    41         .. D XVSET("16^"_X,16,FAC,IFN,DATA) ;Methods
    42         S FAC=""
    43         F  S FAC=$O(^TMP("ORXS2",$J,"QUAL",FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS2",$J,"QUAL",FAC,IFN)) Q:IFN=""  S QUALIF=^(IFN,1),DATA=^(0) D
    44         .I $L(QUALIF) S X=QUALIF D
    45         .. D XVSET("15^"_X,15,FAC,IFN,DATA) ;Qualifiers
    46         S FAC=""
    47         F  S FAC=$O(^TMP("ORXS2",$J,"UNIT",FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS2",$J,"UNIT",FAC,IFN)) Q:IFN=""  S UNIT=^(IFN,1),DATA=^(0) D
    48         .I $L(UNIT) S X=UNIT D
    49         .. D XVSET("17^"_X,17,FAC,IFN,DATA) ;Units
    50         K ^XTMP(HANDLE,"D")
    51         S FAC="",CNT=-1
    52         F  S FAC=$O(^TMP("ORXS1",$J,FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS1",$J,FAC,IFN)) Q:IFN=""  S IFN1="" D
    53         . F  S IFN1=$O(^TMP("ORXS1",$J,FAC,IFN,IFN1)) Q:IFN1=""  S X=^(IFN1) D
    54         .. S CNT=CNT+1,^XTMP(HANDLE,"D",CNT)=X
    55         K ^TMP("ORXS",$J),^TMP("ORXS1",$J),^TMP("ORXS2",$J)
    56         Q
    57 METH(DATA)      ;Get Methods, Units & Qualifiers
    58         Q:'$D(DATA)
    59         N X,D,T
    60         S X=$P($P(DATA,"^",3),"~",2),D=$P($G(DATA),"^",4),T=$P($P(DATA,"^",5),"~",2)
    61         I $L(X),$L(T),$L(D) S METHOD=$G(^TMP("ORXS2",$J,"METH",FAC,IFN,1)),METHOD=$S($L(METHOD):METHOD_" | "_T_":",1:T_":")_X,^TMP("ORXS2",$J,"METH",FAC,IFN,1)=METHOD,^(0)=DATA
    62         S X=$P($P(DATA,"^",8),"~",2)
    63         I $L(X),$L(T),$L(D) S QUALIF=$G(^TMP("ORXS2",$J,"QUAL",FAC,IFN,1)),QUALIF=$S($L(QUALIF):QUALIF_" | "_T_":",1:T_":")_X,^TMP("ORXS2",$J,"QUAL",FAC,IFN,1)=QUALIF,^(0)=DATA
    64         S X=$P($P(DATA,"^",7),"~",2)
    65         I $L(X),$L(T),$L(D) S UNIT=$G(^TMP("ORXS2",$J,"UNIT",FAC,IFN,1)),UNIT=$S($L(UNIT):UNIT_" | "_T_":",1:T_":")_X,^TMP("ORXS2",$J,"UNIT",FAC,IFN,1)=UNIT,^(0)=DATA
    66         Q
    67 XVSET(X,IFN,FAC,IDT,NODE)       ;Setup Vitals nodes
    68         Q:'$D(X)  Q:'$L($G(IDT))
    69         N SAVE,OIDT
    70         S SAVE=X
    71         I '$L($G(IFN)) S CNT=CNT+1,^TMP("ORXS1",$J,IDT,FAC,CNT)=$$ESCP^ORWRP4(SAVE) Q
    72         I $D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D  Q  ;Get data where item, facility, date/time are the same
    73         . S OIDT=IDT
    74         . F  S IDT=IDT+.0001 Q:'$D(^TMP("ORXS1",$J,IDT,IFN))
    75         . I '$D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D
    76         .. S ^TMP("ORXS1",$J,IDT,FAC,1)=$$ESCP^ORWRP4("1^"_$P($G(NODE),"^",2)) ;Facility
    77         .. S ^TMP("ORXS1",$J,IDT,FAC,2)=$$ESCP^ORWRP4("2^"_$$DATE^ORDVU($$SETDATE^ORWRP4($P($G(NODE),"^",4)))) ;Date/Time
    78         . S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE),IDT=OIDT
    79         S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE)
    80         Q
     1ORWRP4V  ; slc/dcm - OE/RR HDR Report Extract RPC's Vitals;9/21/05  13:21
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
     3VS ;Vitals code for HDR
     4 N I,IFN,IFN1,IFN2,X,X1,X2,X4,X5,XIFN,ORX,COL,CODE,I1,CNT,%DT,FAC,FACU,NODE
     5 K ^TMP("ORXS",$J)
     6 S IFN=""
     7 F  S IFN=$O(^XTMP(HANDLE,"D",IFN)) Q:IFN=""  S XIFN=^(IFN) D
     8 . S X11=$P(XIFN,"^",11),X12=$P(XIFN,"^",12),X2=$P(XIFN,"^",2),FACU=X12
     9 . I X12="",X11,X11'=200 S FACU=$O(^DIC(4,"D",X11,0)) I FACU S FACU=$P(^DIC(4,FACU,0),"^")
     10 . I '$L(FACU) S FACU=$S($L($P(XIFN,"^",2)):$P(XIFN,"^",2),1:"Unknown")
     11 . S $P(XIFN,"^",2)=FACU,X4=$P($P(XIFN,"^",4),":",1,2),X5=$P($P(XIFN,"^",5),"~",2)
     12 . I $P(XIFN,"^",10)'="W",$L(X5) D
     13 .. S X4=9999999-$$SETDATE^ORWRP4(X4)
     14 .. I X4=9999999 F I=.01:.01 S X4=X4+I I '$D(^TMP("ORXS",$J,FACU,X4)) Q
     15 .. S ^TMP("ORXS",$J,FACU,X4)=$P(XIFN,"^",2),^TMP("ORXS",$J,FACU,X4,X5,IFN)=XIFN
     16 K ^TMP("ORXS1",$J)
     17 S FAC="",CNT=-1
     18 F  S FAC=$O(^TMP("ORXS",$J,FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS",$J,FAC,IFN)) Q:IFN=""  S NODE=^(IFN) D
     19 . D XVSET("1^"_$P(NODE,"^"),1,FAC,IFN,NODE) ;Facility
     20 . I $P(IFN,".")'=9999999 D XVSET("2^"_$$DATE^ORDVU(9999999-IFN),2,FAC,IFN,NODE) ; Measurement Date/Time
     21 . I $P(IFN,".")=9999999 D XVSET("2^"_" ",2,FAC,IFN,NODE) ; Measurement Date/Time = ""
     22 . S IFN1=""
     23 . F  S IFN1=$O(^TMP("ORXS",$J,FAC,IFN,IFN1)) Q:IFN1=""  S IFN2="" F  S IFN2=$O(^TMP("ORXS",$J,FAC,IFN,IFN1,IFN2)) Q:IFN2=""  S X=^(IFN2) D
     24 .. I $$UPPER^ORU(IFN1)="TEMPERATURE" D XVSET("3^"_$P(X,"^",6),3,FAC,IFN,X)
     25 .. I $$UPPER^ORU(IFN1)="PULSE" D XVSET("4^"_$P(X,"^",6),4,FAC,IFN,X)
     26 .. I $$UPPER^ORU(IFN1)="RESPIRATION" D XVSET("5^"_$P(X,"^",6),5,FAC,IFN,X)
     27 .. I $$UPPER^ORU(IFN1)="BLOOD PRESSURE" D XVSET("6^"_$P(X,"^",6),6,FAC,IFN,X)
     28 .. I $$UPPER^ORU(IFN1)="HEIGHT" D XVSET("7^"_$P(X,"^",6),7,FAC,IFN,X)
     29 .. I $$UPPER^ORU(IFN1)="WEIGHT" D XVSET("8^"_$P(X,"^",6),8,FAC,IFN,X)
     30 .. I $$UPPER^ORU(IFN1)="PAIN" D XVSET("9^"_$P(X,"^",6),9,FAC,IFN,X)
     31 .. I $$UPPER^ORU(IFN1)="PULSE OXIMETRY" D XVSET("10^"_$P(X,"^",6),10,FAC,IFN,X)
     32 .. I $$UPPER^ORU(IFN1)="CENTRAL VENOUS PRESSURE" D XVSET("11^"_$P(X,"^",6),11,FAC,IFN,X)
     33 .. I $$UPPER^ORU(IFN1)="CIRCUMFERENCE/GIRTH" D XVSET("12^"_$P(X,"^",6),12,FAC,IFN,X)
     34 K ^XTMP(HANDLE,"D")
     35 S FAC="",CNT=-1
     36 F  S FAC=$O(^TMP("ORXS1",$J,FAC)) Q:FAC=""  S IFN="" F  S IFN=$O(^TMP("ORXS1",$J,FAC,IFN)) Q:IFN=""  S IFN1="" D
     37 . F  S IFN1=$O(^TMP("ORXS1",$J,FAC,IFN,IFN1)) Q:IFN1=""  S X=^(IFN1) D
     38 .. S CNT=CNT+1,^XTMP(HANDLE,"D",CNT)=X
     39 K ^TMP("ORXS",$J),^TMP("ORXS1",$J)
     40 Q
     41XVSET(X,IFN,FAC,IDT,NODE) ;Setup Vitals nodes
     42 Q:'$D(X)  Q:'$L($G(IDT))
     43 N SAVE,OIDT
     44 S SAVE=X
     45 I '$L($G(IFN)) S CNT=CNT+1,^TMP("ORXS1",$J,IDT,FAC,CNT)=$$ESCP^ORWRP4(SAVE) Q
     46 I $D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D  Q  ;Get data where item, facility, date/time are the same
     47 . S OIDT=IDT
     48 . F  S IDT=IDT+.0001 Q:'$D(^TMP("ORXS1",$J,IDT,IFN))
     49 . I '$D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D
     50 .. S ^TMP("ORXS1",$J,IDT,FAC,1)=$$ESCP^ORWRP4("1^"_$P($G(NODE),"^",2)) ;Facility
     51 .. S ^TMP("ORXS1",$J,IDT,FAC,2)=$$ESCP^ORWRP4("2^"_$$DATE^ORDVU($$SETDATE^ORWRP4($P($G(NODE),"^",4)))) ;Date/Time
     52 . S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE),IDT=OIDT
     53 S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE)
     54 Q
Note: See TracChangeset for help on using the changeset viewer.