- 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 Mar 13, 2025@20:47:34 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
