ORWRP4V ; slc/dcm - OE/RR HDR Report Extract RPC's Vitals;9/21/05 13:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
VS ;Vitals code for HDR
N I,IFN,IFN1,IFN2,X,X1,X2,X4,X5,XIFN,ORX,COL,CODE,I1,CNT,%DT,FAC,FACU,NODE,QUALIF,METHOD,UNIT
K ^TMP("ORXS",$J)
S IFN=""
F S IFN=$O(^XTMP(HANDLE,"D",IFN)) Q:IFN="" S XIFN=^(IFN) D
. S X11=$P(XIFN,"^",11),X12=$P(XIFN,"^",12),X2=$P(XIFN,"^",2),FACU=X12
. I X12="",X11,X11'=200 S FACU=$O(^DIC(4,"D",X11,0)) I FACU S FACU=$P(^DIC(4,FACU,0),"^")
. I '$L(FACU) S FACU=$S($L($P(XIFN,"^",2)):$P(XIFN,"^",2),1:"Unknown")
. S $P(XIFN,"^",2)=FACU,X4=$P($P(XIFN,"^",4),":",1,2),X5=$P($P(XIFN,"^",5),"~",2)
. I $P(XIFN,"^",10)'="W",$L(X5) D
.. S X4=9999999-$$SETDATE^ORWRP4(X4)
.. I X4=9999999 F I=.01:.01 S X4=X4+I I '$D(^TMP("ORXS",$J,FACU,X4)) Q
.. S ^TMP("ORXS",$J,FACU,X4)=$P(XIFN,"^",2),^TMP("ORXS",$J,FACU,X4,X5,IFN)=XIFN
K ^TMP("ORXS1",$J),^TMP("ORXS2",$J)
S FAC="",CNT=-1
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
. D XVSET("1^"_$P(NODE,"^"),1,FAC,IFN,NODE) ;Facility
. I $P(IFN,".")'=9999999 D XVSET("2^"_$$DATE^ORDVU(9999999-IFN),2,FAC,IFN,NODE) ; Measurement Date/Time
. I $P(IFN,".")=9999999 D XVSET("2^"_" ",2,FAC,IFN,NODE) ; Measurement Date/Time = ""
. S IFN1=""
. 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
.. I $$UPPER^ORU(IFN1)="TEMPERATURE" D XVSET("3^"_$P(X,"^",6),3,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="PULSE" D XVSET("4^"_$P(X,"^",6),4,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="RESPIRATION" D XVSET("5^"_$P(X,"^",6),5,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="BLOOD PRESSURE" D XVSET("6^"_$P(X,"^",6),6,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="HEIGHT" D XVSET("7^"_$P(X,"^",6),7,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="WEIGHT" D XVSET("8^"_$P(X,"^",6),8,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="PAIN" D XVSET("9^"_$P(X,"^",6),9,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="PULSE OXIMETRY" D
... D XVSET("10^"_$P(X,"^",6),10,FAC,IFN,X) D METH(X)
... F I=1:1:2 D
.... 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
.... 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
.. I $$UPPER^ORU(IFN1)="CENTRAL VENOUS PRESSURE" D XVSET("11^"_$P(X,"^",6),11,FAC,IFN,X) D METH(X)
.. I $$UPPER^ORU(IFN1)="CIRCUMFERENCE/GIRTH" D XVSET("12^"_$P(X,"^",6),12,FAC,IFN,X) D METH(X)
S FAC=""
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
.I $L(METHOD) S X=METHOD D
.. D XVSET("16^"_X,16,FAC,IFN,DATA) ;Methods
S FAC=""
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
.I $L(QUALIF) S X=QUALIF D
.. D XVSET("15^"_X,15,FAC,IFN,DATA) ;Qualifiers
S FAC=""
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
.I $L(UNIT) S X=UNIT D
.. D XVSET("17^"_X,17,FAC,IFN,DATA) ;Units
K ^XTMP(HANDLE,"D")
S FAC="",CNT=-1
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
. F S IFN1=$O(^TMP("ORXS1",$J,FAC,IFN,IFN1)) Q:IFN1="" S X=^(IFN1) D
.. S CNT=CNT+1,^XTMP(HANDLE,"D",CNT)=X
K ^TMP("ORXS",$J),^TMP("ORXS1",$J),^TMP("ORXS2",$J)
Q
METH(DATA) ;Get Methods, Units & Qualifiers
Q:'$D(DATA)
N X,D,T
S X=$P($P(DATA,"^",3),"~",2),D=$P($G(DATA),"^",4),T=$P($P(DATA,"^",5),"~",2)
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
S X=$P($P(DATA,"^",8),"~",2)
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
S X=$P($P(DATA,"^",7),"~",2)
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
Q
XVSET(X,IFN,FAC,IDT,NODE) ;Setup Vitals nodes
Q:'$D(X) Q:'$L($G(IDT))
N SAVE,OIDT
S SAVE=X
I '$L($G(IFN)) S CNT=CNT+1,^TMP("ORXS1",$J,IDT,FAC,CNT)=$$ESCP^ORWRP4(SAVE) Q
I $D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D Q ;Get data where item, facility, date/time are the same
. S OIDT=IDT
. F S IDT=IDT+.0001 Q:'$D(^TMP("ORXS1",$J,IDT,IFN))
. I '$D(^TMP("ORXS1",$J,IDT,FAC,IFN)) D
.. S ^TMP("ORXS1",$J,IDT,FAC,1)=$$ESCP^ORWRP4("1^"_$P($G(NODE),"^",2)) ;Facility
.. S ^TMP("ORXS1",$J,IDT,FAC,2)=$$ESCP^ORWRP4("2^"_$$DATE^ORDVU($$SETDATE^ORWRP4($P($G(NODE),"^",4)))) ;Date/Time
. S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE),IDT=OIDT
S ^TMP("ORXS1",$J,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRP4V 5124 printed Nov 22, 2024@17:47:20 Page 2
ORWRP4V ; slc/dcm - OE/RR HDR Report Extract RPC's Vitals;9/21/05 13:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
VS ;Vitals code for HDR
+1 NEW I,IFN,IFN1,IFN2,X,X1,X2,X4,X5,XIFN,ORX,COL,CODE,I1,CNT,%DT,FAC,FACU,NODE,QUALIF,METHOD,UNIT
+2 KILL ^TMP("ORXS",$JOB)
+3 SET IFN=""
+4 FOR
SET IFN=$ORDER(^XTMP(HANDLE,"D",IFN))
if IFN=""
QUIT
SET XIFN=^(IFN)
Begin DoDot:1
+5 SET X11=$PIECE(XIFN,"^",11)
SET X12=$PIECE(XIFN,"^",12)
SET X2=$PIECE(XIFN,"^",2)
SET FACU=X12
+6 IF X12=""
IF X11
IF X11'=200
SET FACU=$ORDER(^DIC(4,"D",X11,0))
IF FACU
SET FACU=$PIECE(^DIC(4,FACU,0),"^")
+7 IF '$LENGTH(FACU)
SET FACU=$SELECT($LENGTH($PIECE(XIFN,"^",2)):$PIECE(XIFN,"^",2),1:"Unknown")
+8 SET $PIECE(XIFN,"^",2)=FACU
SET X4=$PIECE($PIECE(XIFN,"^",4),":",1,2)
SET X5=$PIECE($PIECE(XIFN,"^",5),"~",2)
+9 IF $PIECE(XIFN,"^",10)'="W"
IF $LENGTH(X5)
Begin DoDot:2
+10 SET X4=9999999-$$SETDATE^ORWRP4(X4)
+11 IF X4=9999999
FOR I=.01:.01
SET X4=X4+I
IF '$DATA(^TMP("ORXS",$JOB,FACU,X4))
QUIT
+12 SET ^TMP("ORXS",$JOB,FACU,X4)=$PIECE(XIFN,"^",2)
SET ^TMP("ORXS",$JOB,FACU,X4,X5,IFN)=XIFN
End DoDot:2
End DoDot:1
+13 KILL ^TMP("ORXS1",$JOB),^TMP("ORXS2",$JOB)
+14 SET FAC=""
SET CNT=-1
+15 FOR
SET FAC=$ORDER(^TMP("ORXS",$JOB,FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS",$JOB,FAC,IFN))
if IFN=""
QUIT
SET NODE=^(IFN)
Begin DoDot:1
+16 ;Facility
DO XVSET("1^"_$PIECE(NODE,"^"),1,FAC,IFN,NODE)
+17 ; Measurement Date/Time
IF $PIECE(IFN,".")'=9999999
DO XVSET("2^"_$$DATE^ORDVU(9999999-IFN),2,FAC,IFN,NODE)
+18 ; Measurement Date/Time = ""
IF $PIECE(IFN,".")=9999999
DO XVSET("2^"_" ",2,FAC,IFN,NODE)
+19 SET IFN1=""
+20 FOR
SET IFN1=$ORDER(^TMP("ORXS",$JOB,FAC,IFN,IFN1))
if IFN1=""
QUIT
SET IFN2=""
FOR
SET IFN2=$ORDER(^TMP("ORXS",$JOB,FAC,IFN,IFN1,IFN2))
if IFN2=""
QUIT
SET X=^(IFN2)
Begin DoDot:2
+21 IF $$UPPER^ORU(IFN1)="TEMPERATURE"
DO XVSET("3^"_$PIECE(X,"^",6),3,FAC,IFN,X)
DO METH(X)
+22 IF $$UPPER^ORU(IFN1)="PULSE"
DO XVSET("4^"_$PIECE(X,"^",6),4,FAC,IFN,X)
DO METH(X)
+23 IF $$UPPER^ORU(IFN1)="RESPIRATION"
DO XVSET("5^"_$PIECE(X,"^",6),5,FAC,IFN,X)
DO METH(X)
+24 IF $$UPPER^ORU(IFN1)="BLOOD PRESSURE"
DO XVSET("6^"_$PIECE(X,"^",6),6,FAC,IFN,X)
DO METH(X)
+25 IF $$UPPER^ORU(IFN1)="HEIGHT"
DO XVSET("7^"_$PIECE(X,"^",6),7,FAC,IFN,X)
DO METH(X)
+26 IF $$UPPER^ORU(IFN1)="WEIGHT"
DO XVSET("8^"_$PIECE(X,"^",6),8,FAC,IFN,X)
DO METH(X)
+27 IF $$UPPER^ORU(IFN1)="PAIN"
DO XVSET("9^"_$PIECE(X,"^",6),9,FAC,IFN,X)
DO METH(X)
+28 IF $$UPPER^ORU(IFN1)="PULSE OXIMETRY"
Begin DoDot:3
+29 DO XVSET("10^"_$PIECE(X,"^",6),10,FAC,IFN,X)
DO METH(X)
+30 FOR I=1:1:2
Begin DoDot:4
+31 ;Flow Rate
IF $LENGTH($PIECE(X,"^",13))
IF $PIECE($PIECE($PIECE(X,"^",13),"|",I)," ",2)["l/min"
DO XVSET("13^"_$PIECE($PIECE($PIECE(X,"^",13),"|",I)," "),13,FAC,IFN,X)
+32 ;O2 Concentration
IF $LENGTH($PIECE(X,"^",13))
IF $PIECE($PIECE($PIECE(X,"^",13),"|",I)," ",2)["%"
DO XVSET("14^"_$PIECE($PIECE($PIECE(X,"^",13),"|",I)," "),14,FAC,IFN,X)
End DoDot:4
End DoDot:3
+33 IF $$UPPER^ORU(IFN1)="CENTRAL VENOUS PRESSURE"
DO XVSET("11^"_$PIECE(X,"^",6),11,FAC,IFN,X)
DO METH(X)
+34 IF $$UPPER^ORU(IFN1)="CIRCUMFERENCE/GIRTH"
DO XVSET("12^"_$PIECE(X,"^",6),12,FAC,IFN,X)
DO METH(X)
End DoDot:2
End DoDot:1
+35 SET FAC=""
+36 FOR
SET FAC=$ORDER(^TMP("ORXS2",$JOB,"METH",FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS2",$JOB,"METH",FAC,IFN))
if IFN=""
QUIT
SET METHOD=^(IFN,1)
SET DATA=^(0)
Begin DoDot:1
+37 IF $LENGTH(METHOD)
SET X=METHOD
Begin DoDot:2
+38 ;Methods
DO XVSET("16^"_X,16,FAC,IFN,DATA)
End DoDot:2
End DoDot:1
+39 SET FAC=""
+40 FOR
SET FAC=$ORDER(^TMP("ORXS2",$JOB,"QUAL",FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS2",$JOB,"QUAL",FAC,IFN))
if IFN=""
QUIT
SET QUALIF=^(IFN,1)
SET DATA=^(0)
Begin DoDot:1
+41 IF $LENGTH(QUALIF)
SET X=QUALIF
Begin DoDot:2
+42 ;Qualifiers
DO XVSET("15^"_X,15,FAC,IFN,DATA)
End DoDot:2
End DoDot:1
+43 SET FAC=""
+44 FOR
SET FAC=$ORDER(^TMP("ORXS2",$JOB,"UNIT",FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS2",$JOB,"UNIT",FAC,IFN))
if IFN=""
QUIT
SET UNIT=^(IFN,1)
SET DATA=^(0)
Begin DoDot:1
+45 IF $LENGTH(UNIT)
SET X=UNIT
Begin DoDot:2
+46 ;Units
DO XVSET("17^"_X,17,FAC,IFN,DATA)
End DoDot:2
End DoDot:1
+47 KILL ^XTMP(HANDLE,"D")
+48 SET FAC=""
SET CNT=-1
+49 FOR
SET FAC=$ORDER(^TMP("ORXS1",$JOB,FAC))
if FAC=""
QUIT
SET IFN=""
FOR
SET IFN=$ORDER(^TMP("ORXS1",$JOB,FAC,IFN))
if IFN=""
QUIT
SET IFN1=""
Begin DoDot:1
+50 FOR
SET IFN1=$ORDER(^TMP("ORXS1",$JOB,FAC,IFN,IFN1))
if IFN1=""
QUIT
SET X=^(IFN1)
Begin DoDot:2
+51 SET CNT=CNT+1
SET ^XTMP(HANDLE,"D",CNT)=X
End DoDot:2
End DoDot:1
+52 KILL ^TMP("ORXS",$JOB),^TMP("ORXS1",$JOB),^TMP("ORXS2",$JOB)
+53 QUIT
METH(DATA) ;Get Methods, Units & Qualifiers
+1 if '$DATA(DATA)
QUIT
+2 NEW X,D,T
+3 SET X=$PIECE($PIECE(DATA,"^",3),"~",2)
SET D=$PIECE($GET(DATA),"^",4)
SET T=$PIECE($PIECE(DATA,"^",5),"~",2)
+4 IF $LENGTH(X)
IF $LENGTH(T)
IF $LENGTH(D)
SET METHOD=$GET(^TMP("ORXS2",$JOB,"METH",FAC,IFN,1))
SET METHOD=$SELECT($LENGTH(METHOD):METHOD_" | "_T_":",1:T_":")_X
SET ^TMP("ORXS2",$JOB,"METH",FAC,IFN,1)=METHOD
SET ^(0)=DATA
+5 SET X=$PIECE($PIECE(DATA,"^",8),"~",2)
+6 IF $LENGTH(X)
IF $LENGTH(T)
IF $LENGTH(D)
SET QUALIF=$GET(^TMP("ORXS2",$JOB,"QUAL",FAC,IFN,1))
SET QUALIF=$SELECT($LENGTH(QUALIF):QUALIF_" | "_T_":",1:T_":")_X
SET ^TMP("ORXS2",$JOB,"QUAL",FAC,IFN,1)=QUALIF
SET ^(0)=DATA
+7 SET X=$PIECE($PIECE(DATA,"^",7),"~",2)
+8 IF $LENGTH(X)
IF $LENGTH(T)
IF $LENGTH(D)
SET UNIT=$GET(^TMP("ORXS2",$JOB,"UNIT",FAC,IFN,1))
SET UNIT=$SELECT($LENGTH(UNIT):UNIT_" | "_T_":",1:T_":")_X
SET ^TMP("ORXS2",$JOB,"UNIT",FAC,IFN,1)=UNIT
SET ^(0)=DATA
+9 QUIT
XVSET(X,IFN,FAC,IDT,NODE) ;Setup Vitals nodes
+1 if '$DATA(X)
QUIT
if '$LENGTH($GET(IDT))
QUIT
+2 NEW SAVE,OIDT
+3 SET SAVE=X
+4 IF '$LENGTH($GET(IFN))
SET CNT=CNT+1
SET ^TMP("ORXS1",$JOB,IDT,FAC,CNT)=$$ESCP^ORWRP4(SAVE)
QUIT
+5 ;Get data where item, facility, date/time are the same
IF $DATA(^TMP("ORXS1",$JOB,IDT,FAC,IFN))
Begin DoDot:1
+6 SET OIDT=IDT
+7 FOR
SET IDT=IDT+.0001
if '$DATA(^TMP("ORXS1",$JOB,IDT,IFN))
QUIT
+8 IF '$DATA(^TMP("ORXS1",$JOB,IDT,FAC,IFN))
Begin DoDot:2
+9 ;Facility
SET ^TMP("ORXS1",$JOB,IDT,FAC,1)=$$ESCP^ORWRP4("1^"_$PIECE($GET(NODE),"^",2))
+10 ;Date/Time
SET ^TMP("ORXS1",$JOB,IDT,FAC,2)=$$ESCP^ORWRP4("2^"_$$DATE^ORDVU($$SETDATE^ORWRP4($PIECE($GET(NODE),"^",4))))
End DoDot:2
+11 SET ^TMP("ORXS1",$JOB,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE)
SET IDT=OIDT
End DoDot:1
QUIT
+12 SET ^TMP("ORXS1",$JOB,IDT,FAC,IFN)=$$ESCP^ORWRP4(SAVE)
+13 QUIT
