MDHL7R1 ; HOIFO/WAA -Clinivision Resporatory ; 06/13/02
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
; Reference Supported DBIA #10035 PATIENT
; Reference Supported DBIA #10106 HL7
; IA# 10103 [Supported] Calls to XLFT
; 10090 [Supported] FM read of DIC(4
;
OBX ; Process OBX
N MDATT,PROC,P,PNAM,AGE,DOB,DOBAGE,STATION
I $G(STATION) S STATION=$$FIND1^DIC(4,"","MX",STATION)
S:'$L($G(STATION)) STATION=$G(DUZ(2))
S PNAM=$P(^DPT(DFN,0),U,1)
S DOB=$P(^DPT(DFN,0),U,3)
S DOB=$$FMTE^XLFDT(DOB,"1D")
S AGE=$$GET1^DIQ(2,DFN,.033)
S DOBAGE=DOB_" ("_AGE_")"
K ^TMP($J,"MDHL7","TEXT")
S P="|"
D ATT^MDHL7U(DEVIEN,.MDATT) Q:MDATT<1
S PROC=0
F S PROC=$O(MDATT(PROC)) Q:PROC<1 D
. N PROCESS
. S PROCESS=$P(MDATT(PROC),";",5)
. I PROCESS="TEXT^MDHL7U2" D TXT
. D @PROCESS
. Q
Q:'MDIEN
D REX^MDHL7U1(MDIEN)
D GENACK^MDHL7X
Q
TXT ; Extract data and process it for the test fuinction
N CNT,CNT2,LINE,LINE2
S (CNT,CNT2)=0
F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
. S LINE=^TMP($J,"MDHL7A",CNT)
. I $P(LINE,P,1)="PID" D Q ;HEADER
.. N SPC
.. S LINE2=$J("Report from: ",31)_$$GET1^DIQ(4,+STATION_",",.01,"E")_" Station #"_$$GET1^DIQ(4,+STATION_",",99,"E")
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
.. S LINE2="Clinivision Report"
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
.. S LINE2=PNAM_" "_$E(MDSSN,1,3)_"-"_$E(MDSSN,4,5)_"-"_$E(MDSSN,6,9)
.. S SPC=77-$L(LINE2),LINE2=LINE2_$J(DOBAGE,SPC)
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
.. Q
. I $P(LINE,P,1)="OBR" D Q
.. S LINE2=""
.. S $P(LINE2,"=",79)=""
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
.. S LINE2=$$FMDATE^HLFNC($E($P(LINE,P,8),1,14))
.. S LINE2=$$FMTE^XLFDT(LINE2,"1P")
.. S LINE2="REPORT DATE: "_LINE2
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
.. Q
. I $P(LINE,P,1)'="OBX" Q
. I $P(LINE,P,3)'="ST" Q
. S LINE2=$P($P(LINE,P,4),U,2)
. I LINE2="Comment" D
.. S LINE2=""
.. S CNT2=CNT2+1
.. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||Comment:"
.. Q
. E S LINE2=LINE2_": "
. S LINE2=LINE2_$P(LINE,P,6)
. S CNT2=CNT2+1
. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7R1 2310 printed Nov 22, 2024@16:53:06 Page 2
MDHL7R1 ; HOIFO/WAA -Clinivision Resporatory ; 06/13/02
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
+2 ; Reference Supported DBIA #10035 PATIENT
+3 ; Reference Supported DBIA #10106 HL7
+4 ; IA# 10103 [Supported] Calls to XLFT
+5 ; 10090 [Supported] FM read of DIC(4
+6 ;
OBX ; Process OBX
+1 NEW MDATT,PROC,P,PNAM,AGE,DOB,DOBAGE,STATION
+2 IF $GET(STATION)
SET STATION=$$FIND1^DIC(4,"","MX",STATION)
+3 if '$LENGTH($GET(STATION))
SET STATION=$GET(DUZ(2))
+4 SET PNAM=$PIECE(^DPT(DFN,0),U,1)
+5 SET DOB=$PIECE(^DPT(DFN,0),U,3)
+6 SET DOB=$$FMTE^XLFDT(DOB,"1D")
+7 SET AGE=$$GET1^DIQ(2,DFN,.033)
+8 SET DOBAGE=DOB_" ("_AGE_")"
+9 KILL ^TMP($JOB,"MDHL7","TEXT")
+10 SET P="|"
+11 DO ATT^MDHL7U(DEVIEN,.MDATT)
if MDATT<1
QUIT
+12 SET PROC=0
+13 FOR
SET PROC=$ORDER(MDATT(PROC))
if PROC<1
QUIT
Begin DoDot:1
+14 NEW PROCESS
+15 SET PROCESS=$PIECE(MDATT(PROC),";",5)
+16 IF PROCESS="TEXT^MDHL7U2"
DO TXT
+17 DO @PROCESS
+18 QUIT
End DoDot:1
+19 if 'MDIEN
QUIT
+20 DO REX^MDHL7U1(MDIEN)
+21 DO GENACK^MDHL7X
+22 QUIT
TXT ; Extract data and process it for the test fuinction
+1 NEW CNT,CNT2,LINE,LINE2
+2 SET (CNT,CNT2)=0
+3 FOR
SET CNT=$ORDER(^TMP($JOB,"MDHL7A",CNT))
if CNT<1
QUIT
Begin DoDot:1
+4 SET LINE=^TMP($JOB,"MDHL7A",CNT)
+5 ;HEADER
IF $PIECE(LINE,P,1)="PID"
Begin DoDot:2
+6 NEW SPC
+7 SET LINE2=$JUSTIFY("Report from: ",31)_$$GET1^DIQ(4,+STATION_",",.01,"E")_" Station #"_$$GET1^DIQ(4,+STATION_",",99,"E")
+8 SET CNT2=CNT2+1
+9 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+10 SET LINE2="Clinivision Report"
+11 SET CNT2=CNT2+1
+12 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+13 SET LINE2=PNAM_" "_$EXTRACT(MDSSN,1,3)_"-"_$EXTRACT(MDSSN,4,5)_"-"_$EXTRACT(MDSSN,6,9)
+14 SET SPC=77-$LENGTH(LINE2)
SET LINE2=LINE2_$JUSTIFY(DOBAGE,SPC)
+15 SET CNT2=CNT2+1
+16 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+17 QUIT
End DoDot:2
QUIT
+18 IF $PIECE(LINE,P,1)="OBR"
Begin DoDot:2
+19 SET LINE2=""
+20 SET $PIECE(LINE2,"=",79)=""
+21 SET CNT2=CNT2+1
+22 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+23 SET LINE2=$$FMDATE^HLFNC($EXTRACT($PIECE(LINE,P,8),1,14))
+24 SET LINE2=$$FMTE^XLFDT(LINE2,"1P")
+25 SET LINE2="REPORT DATE: "_LINE2
+26 SET CNT2=CNT2+1
+27 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+28 QUIT
End DoDot:2
QUIT
+29 IF $PIECE(LINE,P,1)'="OBX"
QUIT
+30 IF $PIECE(LINE,P,3)'="ST"
QUIT
+31 SET LINE2=$PIECE($PIECE(LINE,P,4),U,2)
+32 IF LINE2="Comment"
Begin DoDot:2
+33 SET LINE2=""
+34 SET CNT2=CNT2+1
+35 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||Comment:"
+36 QUIT
End DoDot:2
+37 IF '$TEST
SET LINE2=LINE2_": "
+38 SET LINE2=LINE2_$PIECE(LINE,P,6)
+39 SET CNT2=CNT2+1
+40 SET ^TMP($JOB,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
+41 QUIT
End DoDot:1
+42 QUIT
