source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDHL7R1.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1MDHL7R1 ; HOIFO/WAA -Clinivision Resporatory ; 06/13/02
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ; Reference Supported DBIA #10035 PATIENT
4 ; Reference Supported DBIA #10106 HL7
5 ; IA# 10103 [Supported] Calls to XLFT
6 ; 10090 [Supported] FM read of DIC(4
7 ;
8OBX ; Process OBX
9 N MDATT,PROC,P,PNAM,AGE,DOB,DOBAGE,STATION
10 I $G(STATION) S STATION=$$FIND1^DIC(4,"","MX",STATION)
11 S:'$L($G(STATION)) STATION=$G(DUZ(2))
12 S PNAM=$P(^DPT(DFN,0),U,1)
13 S DOB=$P(^DPT(DFN,0),U,3)
14 S DOB=$$FMTE^XLFDT(DOB,"1D")
15 S AGE=$$GET1^DIQ(2,DFN,.033)
16 S DOBAGE=DOB_" ("_AGE_")"
17 K ^TMP($J,"MDHL7","TEXT")
18 S P="|"
19 D ATT^MDHL7U(DEVIEN,.MDATT) Q:MDATT<1
20 S PROC=0
21 F S PROC=$O(MDATT(PROC)) Q:PROC<1 D
22 . N PROCESS
23 . S PROCESS=$P(MDATT(PROC),";",5)
24 . I PROCESS="TEXT^MDHL7U2" D TXT
25 . D @PROCESS
26 . Q
27 Q:'MDIEN
28 D REX^MDHL7U1(MDIEN)
29 D GENACK^MDHL7X
30 Q
31TXT ; Extract data and process it for the test fuinction
32 N CNT,CNT2,LINE,LINE2
33 S (CNT,CNT2)=0
34 F S CNT=$O(^TMP($J,"MDHL7A",CNT)) Q:CNT<1 D
35 . S LINE=^TMP($J,"MDHL7A",CNT)
36 . I $P(LINE,P,1)="PID" D Q ;HEADER
37 .. N SPC
38 .. S LINE2=$J("Report from: ",31)_$$GET1^DIQ(4,+STATION_",",.01,"E")_" Station #"_$$GET1^DIQ(4,+STATION_",",99,"E")
39 .. S CNT2=CNT2+1
40 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
41 .. S LINE2="Clinivision Report"
42 .. S CNT2=CNT2+1
43 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
44 .. S LINE2=PNAM_" "_$E(MDSSN,1,3)_"-"_$E(MDSSN,4,5)_"-"_$E(MDSSN,6,9)
45 .. S SPC=77-$L(LINE2),LINE2=LINE2_$J(DOBAGE,SPC)
46 .. S CNT2=CNT2+1
47 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
48 .. Q
49 . I $P(LINE,P,1)="OBR" D Q
50 .. S LINE2=""
51 .. S $P(LINE2,"=",79)=""
52 .. S CNT2=CNT2+1
53 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
54 .. S LINE2=$$FMDATE^HLFNC($E($P(LINE,P,8),1,14))
55 .. S LINE2=$$FMTE^XLFDT(LINE2,"1P")
56 .. S LINE2="REPORT DATE: "_LINE2
57 .. S CNT2=CNT2+1
58 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
59 .. Q
60 . I $P(LINE,P,1)'="OBX" Q
61 . I $P(LINE,P,3)'="ST" Q
62 . S LINE2=$P($P(LINE,P,4),U,2)
63 . I LINE2="Comment" D
64 .. S LINE2=""
65 .. S CNT2=CNT2+1
66 .. S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||Comment:"
67 .. Q
68 . E S LINE2=LINE2_": "
69 . S LINE2=LINE2_$P(LINE,P,6)
70 . S CNT2=CNT2+1
71 . S ^TMP($J,"MDHL7","TEXT",CNT2)="OBX||TX|||"_LINE2
72 . Q
73 Q
Note: See TracBrowser for help on using the repository browser.