source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP4V.m@ 623

Last change on this file since 623 was 623, checked in by George Lilly, 14 years ago

revised back to 6/30/08 version

File size: 3.1 KB
Line 
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 TracBrowser for help on using the repository browser.