- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHLU.m
r613 r623 1 PSJHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;20 Apr 98 / 9:58 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**1,56,72,102,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(52.6 is supported by DBIA# 1231. 5 ; Reference to ^PS(52.7 is supported by DBIA# 2173. 6 ; Reference to ^VA(200 is supported by DBIA 10060. 7 ; Reference to ^PS(55 is supported by DBIA# 2191. 8 ; 9 INIT ; set up HL7 application variables 10 S PSJHLSDT="PS",PSJHINST=$P($$SITE^VASITE(),"^") 11 S PSJCLEAR="K FIELD F J=0:1:LIMIT S FIELD(J)=""""" 12 Q 13 ; 14 SEGMENT(LIMIT) ; 15 K SEGMENT 16 N SUBSEG,SEGLENGT S SUBSEG=0,SEGMENT="" F J=0:1:LIMIT D 17 .I SEGMENT']"" S SEGMENT=FIELD(J) Q 18 .S SEGMENT=SEGMENT_"|"_FIELD(J) 19 F S SEGLENGT=$L(SEGMENT) D Q:$L(SEGMENT)'>246 20 .I SEGLENGT'>246 S SEGMENT(SUBSEG)=SEGMENT 21 .I SEGLENGT>245 S SEGMENT(SUBSEG)=$E(SEGMENT,1,245),SUBSEG=SUBSEG+1 D 22 ..S SEGMENT=$E(SEGMENT,246,SEGLENGT),SEGMENT(SUBSEG)=$E(SEGMENT,1,245) 23 SET S PSJI=PSJI+1,^TMP("PSJHLS",$J,PSJHLSDT,PSJI)=SEGMENT(0) 24 F J=1:1 Q:'$D(SEGMENT(J)) S ^TMP("PSJHLS",$J,PSJHLSDT,PSJI,J)=SEGMENT(J) 25 Q 26 ; 27 SEGMENT2 ; Retrieve text fields 28 K SEGMENT S JJ=0 F S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ S SEGMENT(JJ-1)=$G(@(PSJORDER_"12,"_JJ_",0)")) 29 I $D(SEGMENT(0)) S SEGMENT(0)="NTE|6|L|"_$S($G(PSJBCBU):SEGMENT(0),1:$$ESC^ORHLESC(SEGMENT(0))) D 30 .D SET^PSJHLU K SEGMENT,JJ 31 I $P($G(@(PSJORDER_"6)")),"^")]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$S($G(PSJBCBU):$P($G(@(PSJORDER_"6)")),"^"),1:$$ESC^ORHLESC($P($G(@(PSJORDER_"6)")),"^"))) D 32 .D SET^PSJHLU K SEGMENT 33 I PSJORDER["P",$P($G(@(PSJORDER_"9)")),"^",2)]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$S($G(PSJBCBU):$P($G(@(PSJORDER_"9)")),"^",2),1:$$ESC^ORHLESC($P($G(@(PSJORDER_"9)")),"^",2))) D 34 .D SET^PSJHLU K SEGMENT 35 Q 36 ; 37 CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders 38 ; HLEVN = number of segments in message 39 K CLERK,DDIEN,DDNUM,DOSEFORM,DOSEOR,FIELD,IVTYPE,LIMIT,NAME,NDNODE,NODE1,NODE2,PRODNAME,PROVIDER,PSGS0Y,PSJHINST,PSJHLSDT,PSJI,PSJORDER,PSOC,PSREASON,ROOMBED,SPDIEN,SEGMENT 40 I $G(PSJBCBU)=1 M PSJNAME=^TMP("PSJHLS",$J,"PS") Q 41 S PSJMSG="^TMP(""PSJHLS"",$J,""PS"")" 42 D MSG^XQOR("PS EVSEND OR",.PSJMSG) 43 Q 44 ; 45 IVTYPE(PSJORDER) ; check whether a back-door order is Inpatient IV or IV fluid 46 I RXORDER["V",$P($G(@(PSJORDER_"0)")),"^",4)'="A" Q "I" 47 I RXORDER["P" I $P($G(@(PSJORDER_"0)")),"^",4)'="F" S IVTYPE="" Q IVTYPE 48 N SUB,AD,SOL,IVTYPE,NODE1 S SUB=0,IVTYPE="F" 49 ;naked reference on line below refers to the full indirect reference of PSJORDER_ which is from ^PS(55,DFN,"IV",PSJORD 50 F TYPE="AD","SOL" S SUB=0 F S SUB=$O(@(PSJORDER_""""_TYPE_""""_","_SUB_")")) Q:(SUB="")!(IVTYPE="I") S NODE1=$G(^(SUB,0)) Q:NODE1="" D Q:IVTYPE="I" 51 .I TYPE="AD" D 52 ..I '$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",13) S IVTYPE="I" 53 .D:TYPE="SOL" 54 ..S:'$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",13) IVTYPE="I" 55 Q IVTYPE 56 ENI ;Calculate Frequency for IV orders 57 N INFUSE 58 I X?.E1L.E S INFUSE=$$ENLU^PSGMI(X) Q:(INFUSE="TITRATE")!(INFUSE="BOLUS")!($P(INFUSE," ")="INFUSE")!($P(INFUSE," ")="Infuse") 59 Q:(X="TITRATE")!(X="BOLUS")!($P(X," ")="INFUSE")!($P(X," ")="Infuse") 60 Q:$$INTRMT(X) 61 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q 62 I X["=" D Q ; NOIS LOU-0501-42191 63 .N X2,X1 S X1=$P(X,"="),X2=$P(X,"=",2) 64 .I X1["ML/HR",(+X1=$P(X1,"ML/HR"))!(+X1=$P(X1," ML/HR")) D 65 ..S X1=$TR(X1,"ML/HR","ml/hr") 66 .I X2["ML/HR",(+X2=$P(X2,"ML/HR"))!(+X2=$P(X2," ML/HR")) D 67 ..S X2=$TR(X2,"ML/HR","ml/hr") 68 .I X1[" ml/hr",(+X1=$P(X1," ml/hr")) D 69 ..S X1=$P(X1," ml/hr")_$P(X1," ml/hr",2,9999) 70 .I X2[" ml/hr",(+X2=$P(X2," ml/hr")) D 71 ..S X2=$P(X2," ml/hr")_$P(X2," ml/hr",2,9999) 72 .I X1["ml/hr",(+X1=$P(X1,"ml/hr")) D 73 ..S X1=$P(X1,"ml/hr")_$P(X1,"ml/hr",2,9999) 74 .I X2["ml/hr",(+X2=$P(X2,"ml/hr")) D 75 ..S X2=$P(X2,"ml/hr")_$P(X2,"ml/hr",2,9999) 76 .I X2'=+X2 D 77 ..I ($P(X2,"@",2,999)'=+$P(X2,"@",2,999)!(+$P(X2,"@",2,999)<0)) K X Q 78 .I X1=+X1 S X1=X1_" ml/hr" 79 .I X2=+X2 S X2=X2_" ml/hr" 80 .S:$P(X2,"@")=+X2 $P(X2,"@")=$P(X2,"@")_" ml/hr" 81 .S X=X1_"="_X2 82 I X'=+X,($P($TR(X," ml/hr",""),"@",2,999)'=+$P($TR(X," ml/hr",""),"@",2,999)!(+$P(X,"@",2,999)<0)),($P(X," ml/hr")'=+$P(X," ml/hr")!(+$P(X," ml/hr")<0)) Q:(X>0&($E(X)=0)) K X Q 83 I X=+X!(X>0&($E(X)=0)) S X=X_" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q 84 I X[" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q 85 S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" S FREQ=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL 86 Q 87 SPSOL S SPSOL=+TVOLUME Q 88 INTRMT(X) ; 89 Q:'$P(X," ") 0 90 Q:$P(X," ",2)="Minutes" 1 91 Q:$P(X," ",2)="Hours" 1 92 Q 0 93 IVCAT(DFN,PSJORD,PARRAY) ; This returns the IV CATEGORY based on the IV TYPE and CHEMO TYPE (not what is already in the IV CATEGORY field) 94 ; Passed in: PSJORDER (file root of order) 95 N NODE,TYP,CHEMTYP,INTSYR,ND2P5 96 S (CHEMTYP,INTSYR)="" 97 S TYP=$G(P(4)),INTSYR=$G(P(5)),CHEMTYP=$G(P(23)) 98 I TYP="",$G(PSJORD)["V" S NODE=$G(^PS(55,DFN,"IV",+PSJORD,0)) S TYP=$P(NODE,"^",4),INTSYR=$P(NODE,"^",5),CHEMTYP=$P(NODE,"^",23) 99 I TYP="",$G(PSJORD)["P" S NODE=$G(^PS(53.1,+PSJORD,8)) S TYP=$P(NODE,"^"),INTSYR=$P(NODE,"^",4),CHEMTYP=$P(NODE,"^",2) 100 I TYP="" S TYP=$G(PARRAY(4)),INTSYR=$G(PARRAY(5)),CHEMTYP=$G(PARRAY(23)) 101 Q:$G(TYP)="" "" 102 S CAT=$S(",A,H,"[(","_TYP_","):"C",TYP="C"&(",A,H,S,"[(","_CHEMTYP_",")&'INTSYR):"C",TYP="C"&(CHEMTYP="P"):"I",TYP="S"&'INTSYR:"C",TYP="P":"I",$G(INTSYR):"I",1:"") 103 Q CAT 104 ZRX ; Perform outbound processing 105 S LIMIT=6 X PSJCLEAR 106 S FIELD(0)="ZRX" 107 I '$G(PSJREN) N PREON,PSJREN I $G(PSJORD)["U"&($P(NODE1,"^",24)="R") S PSJREN=1 108 I $G(PSJORD)["V"&($P(NODE2,"^",8)="R") S PSJREN=1 109 S PREON=$S($G(PSJREN):$G(PSJORD),PSJORDER["IV":$P(NODE2,"^",5),1:$P(NODE1,"^",25)) 110 S FIELD(1)=$S(PREON["P":$P($G(^PS(53.1,+PREON,0)),"^",21),PREON["V":$P($G(^PS(55,PSJHLDFN,"IV",+PREON,0)),"^",21),1:$P($G(^PS(55,PSJHLDFN,5,+PREON,0)),"^",21)) 111 S FIELD(2)=$S(PSJORDER["IV":$G(P("NAT")),1:$G(PSJNOO)) 112 S FIELD(3)=$S($G(PSJREN):"R",PSJORDER["IV":$P(NODE2,"^",8),1:$P(NODE1,"^",24)) 113 I FIELD(3)="" I PSOC="SN" S FIELD(3)="N" 114 I $D(P)>1 S FIELD(6)=$$IVCAT^PSJHLU(PSJHLDFN,RXORDER,.P) 115 S NAME=$P($G(^VA(200,DUZ,0)),"^") 116 S FIELD(5)=DUZ_"^"_$S($G(PSJBCBU):NAME,1:$$ESC^ORHLESC(NAME))_"^"_"99NP" 117 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2 118 Q 1 PSJHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;20 Apr 98 / 9:58 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**1,56,72,102**;16 DEC 97 3 ; 4 ; Reference to ^PS(52.6 is supported by DBIA# 1231. 5 ; Reference to ^PS(52.7 is supported by DBIA# 2173. 6 ; 7 INIT ; set up HL7 application variables 8 S PSJHLSDT="PS",PSJHINST=$P($$SITE^VASITE(),"^") 9 S PSJCLEAR="K FIELD F J=0:1:LIMIT S FIELD(J)=""""" 10 Q 11 ; 12 SEGMENT(LIMIT) ; 13 K SEGMENT 14 N SUBSEG,SEGLENGT S SUBSEG=0,SEGMENT="" F J=0:1:LIMIT D 15 .I SEGMENT']"" S SEGMENT=FIELD(J) Q 16 .S SEGMENT=SEGMENT_"|"_FIELD(J) 17 F S SEGLENGT=$L(SEGMENT) D Q:$L(SEGMENT)'>246 18 .I SEGLENGT'>246 S SEGMENT(SUBSEG)=SEGMENT 19 .I SEGLENGT>245 S SEGMENT(SUBSEG)=$E(SEGMENT,1,245),SUBSEG=SUBSEG+1 D 20 ..S SEGMENT=$E(SEGMENT,246,SEGLENGT),SEGMENT(SUBSEG)=$E(SEGMENT,1,245) 21 SET S PSJI=PSJI+1,^TMP("PSJHLS",$J,PSJHLSDT,PSJI)=SEGMENT(0) 22 F J=1:1 Q:'$D(SEGMENT(J)) S ^TMP("PSJHLS",$J,PSJHLSDT,PSJI,J)=SEGMENT(J) 23 Q 24 ; 25 CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders 26 ; HLEVN = number of segments in message 27 K CLERK,DDIEN,DDNUM,DOSEFORM,DOSEOR,FIELD,IVTYPE,LIMIT,NAME,NDNODE,NODE1,NODE2,PRODNAME,PROVIDER,PSGS0Y,PSJHINST,PSJHLSDT,PSJI,PSJORDER,PSOC,PSREASON,ROOMBED,SPDIEN,SEGMENT 28 I $G(PSJBCBU)=1 M PSJNAME=^TMP("PSJHLS",$J,"PS") Q 29 S PSJMSG="^TMP(""PSJHLS"",$J,""PS"")" 30 D MSG^XQOR("PS EVSEND OR",.PSJMSG) 31 Q 32 ; 33 IVTYPE(PSJORDER) ; check whether a back-door order is Inpatient IV or IV fluid 34 I RXORDER["V",$P($G(@(PSJORDER_"0)")),"^",4)'="A" Q "I" 35 I RXORDER["P" I $P($G(@(PSJORDER_"0)")),"^",4)'="F" S IVTYPE="" Q IVTYPE 36 N SUB,AD,SOL,IVTYPE,NODE1 S SUB=0,IVTYPE="F" 37 ;naked reference on line below refers to the full indirect reference of PSJORDER_... 38 F TYPE="AD","SOL" S SUB=0 F S SUB=$O(@(PSJORDER_""""_TYPE_""""_","_SUB_")")) Q:(SUB="")!(IVTYPE="I") S NODE1=$G(^(SUB,0)) Q:NODE1="" D Q:IVTYPE="I" 39 .I TYPE="AD" D 40 ..I '$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",13) S IVTYPE="I" 41 .D:TYPE="SOL" 42 ..S:'$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",13) IVTYPE="I" 43 Q IVTYPE 44 ENI ;Calculate Frequency for IV orders 45 N INFUSE 46 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q 47 I X?.E1L.E S INFUSE=$$ENLU^PSGMI(X) Q:(INFUSE="TITRATE")!(INFUSE="BOLUS") 48 Q:(X="TITRATE")!(X="BOLUS") 49 I X["=" D Q ; NOIS LOU-0501-42191 50 .N X2,X1 S X1=$P(X,"="),X2=$P(X,"=",2) 51 .I X1["ML/HR",(+X1=$P(X1,"ML/HR"))!(+X1=$P(X1," ML/HR")) D 52 ..S X1=$TR(X1,"ML/HR","ml/hr") 53 .I X2["ML/HR",(+X2=$P(X2,"ML/HR"))!(+X2=$P(X2," ML/HR")) D 54 ..S X2=$TR(X2,"ML/HR","ml/hr") 55 .I X1[" ml/hr",(+X1=$P(X1," ml/hr")) D 56 ..S X1=$P(X1," ml/hr")_$P(X1," ml/hr",2,9999) 57 .I X2[" ml/hr",(+X2=$P(X2," ml/hr")) D 58 ..S X2=$P(X2," ml/hr")_$P(X2," ml/hr",2,9999) 59 .I X1["ml/hr",(+X1=$P(X1,"ml/hr")) D 60 ..S X1=$P(X1,"ml/hr")_$P(X1,"ml/hr",2,9999) 61 .I X2["ml/hr",(+X2=$P(X2,"ml/hr")) D 62 ..S X2=$P(X2,"ml/hr")_$P(X2,"ml/hr",2,9999) 63 .I X2'=+X2 D 64 ..I ($P(X2,"@",2,999)'=+$P(X2,"@",2,999)!(+$P(X2,"@",2,999)<0)) K X Q 65 .I X1=+X1 S X1=X1_" ml/hr" 66 .I X2=+X2 S X2=X2_" ml/hr" 67 .S:$P(X2,"@")=+X2 $P(X2,"@")=$P(X2,"@")_" ml/hr" 68 .S X=X1_"="_X2 69 I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)),($P(X," ml/hr")'=+$P(X," ml/hr")!(+$P(X," ml/hr")<0)) K X Q 70 I X=+X S X=X_" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q 71 I X[" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q 72 S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" S FREQ=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL 73 Q 74 SPSOL S SPSOL=+TVOLUME Q
Note:
See TracChangeset
for help on using the changeset viewer.
