source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLVORU.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1SRHLVORU ;B'HAM ISC/DLR - Surgery Interface Receiver of ORU message ; [ 05/06/98 7:14 AM ]
2 ;;3.0; Surgery ;**41**;24 Jun 93
3 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;processing of incoming ORU message
5 ; 1. process MSH - create field separator and other encoding characters
6 ; 2. process PID - establish patient IEN
7 ; 3. process OBR - create observation identifier and stuff fields
8 ; a. process OBX - using OBR identifier stuff fields
9 ; b. process NTE - using OBR identifier stuff anesthesia comment
10 ; 4. use ^TMP("SRHL" global to create a descrepancy report if needed
11 ;
12 ; Troubleshooting
13 ; What to do if a field is not being added?
14 ; 1. View descrepancy message.
15 ; 2. Check the Flag Interface Fields option for a receive flag.
16 ; 3. Check to see if the field has an input transform.
17 ;
18REC N DFN,DFN1,HLCOMP,HLREP,HLSUB,II,SG,SRERR,SRI,SRHLX,SSN,TYPE,QOBR
19 S QOBR=1 ;flag for stopping OBR segments from being processed
20 S UPDATE=0
21 S SRHLX=1 K ^TMP("SRHL")
22 S SRNOCON=1 ;no concurrent case information
23 S II=0 F S II=$O(^HL(772,HLDA,"IN",II)) Q:'II!$D(HLERR) S MSG=^HL(772,HLDA,"IN",II,0),SG=$E(^(0),1,3) D PICK
24 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) D ^DIE K DR,DO,DIE
25EXIT ;
26 S HLMTN="ACK",HLSDT=1,SRI=1
27 D MSA^SRHLVUO(.SRI,$S($D(HLERR):"AE",1:"AA"))
28 I $D(HLERR) D ERR^SRHLVUO(.SRI,.SRERR)
29 W:$G(HLERR)'="" !,"ERROR ",$G(HLERR)
30 W:$G(HLERR)="" !,"NO ERROR"
31 D EN^HLTRANS
32 I $D(^TMP("SRHL")) K DIC S DIC="^XMB(3.8,",X="SRHL DISCREPANCY" D ^DIC K DIC Q:Y=-1 D REPORT(HLMID)
33 Q
34PICK ;check routine for segment entry point
35 I $T(@SG)]"" D @SG
36 I $T(@SG)="" S HLERR="Invalid segment "_$G(SG)_" in message "_$G(TYPE) Q
37 Q
38MSH ;process the MSH segment
39 S HLFS=$E(MSG,4),HLECH=$E(MSG,5,8)
40 S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)
41 S TYPE=$P(MSG,HLFS,9)
42 Q
43PID ;process PID segment
44 N I,PAT,SSN
45 S SSN=$P(MSG,HLFS,20),PAT=$$FMNAME^HLFNC($P(MSG,HLFS,6))
46 I $G(PAT)'="" F I=0:0 S I=$O(^DPT("B",PAT,I)) Q:'I S DFN=I
47 I $G(SSN)'="" S DFN1=$O(^DPT("SSN",SSN,0))
48 I $G(DFN)=""&($G(DFN1)="") S HLERR="Invalid Patient Name or SSN"
49 E I $G(DFN)'=$G(DFN1) S ^TMP("SRHL",SRHLX)=PAT_" does not match SSN, "_SSN_".",SRHLX=SRHLX+1
50 Q
51OBX ;OBX segments processing
52 I '$D(HLERR)&($G(QOBR)=0) D:'$D(DR)&($D(OBR)) OBR^SRHLVUI("",OBR) D OBX^SRHLVUI2(MSG,OBR) I UPDATE=1 W !,"DR ",DR D ^DIE K DR,DO S UPDATE=0
53 Q
54NTE ;NTE segment processing
55 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) D ^DIE K DR,DO
56 I '$D(HLERR)&($G(QOBR)'=1)&($D(OBR)) D NTE^SRHLVUI2(MSG,OBR)
57 Q
58DSC Q
59OBR ;OBR segment processing
60 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) W !,"OBR DR",DR D ^DIE K DR,DO,DIE
61 N CASE,CDFN,ID,IEN
62 S QOBR=0
63 ;set-up the IDentifier and check the mapping file (#133.2) for a match
64 S ID=$P($P(MSG,HLFS,5),HLCOMP,2) I $G(ID)="" S HLERR="Missing OBR identifier" Q
65 S IEN=$O(^SRO(133.2,"AC",ID,0)) I $G(IEN)="" D SET("Invalid OBR identifier",OBR,"",.SRHLX) Q
66 S CASE=$P(MSG,HLFS,4) I CASE="" S HLERR="NULL Case Number" Q
67 I '$D(^SRF(CASE,0)) S HLERR="Invalid Surgery Case Number" Q
68 I $D(^SRF(CASE,0)) S CDFN=$P(^SRF(CASE,0),U) I CDFN'=$G(DFN)&((CDFN'=$G(DFN1))) S HLERR="Mismatch of PID patient and Case patient" Q
69 ;get the next OBR segment that is set to receive
70 I $$CHECK(IEN)'=1 S QOBR=1 Q
71 S (SRTN,DA)=CASE,DIE=$P(^SRO(133.2,IEN,0),U,2)
72 ;process the OBR identifier that is set to receive
73 I $$CHECK(IEN)=1 S OBR=MSG D:'$D(HLERR) OBR^SRHLVUI(IEN,OBR)
74 Q
75CHECK(IEN) ;check for valid receivable segments in file 133.2 (Surgery Interface)
76 I $G(IEN)="" Q 0
77 Q $P($G(^SRO(133.2,IEN,0)),U,4)["R"
78REPORT(HLMID) ;creates discrepancy report to be mailed to SR HL7 mailgroup
79 S XMSUB="Message #"_HLMID_" contains Surgery application discrepancies."
80 S XMY("G.SRHL DISCREPANCY")=""
81 S XMTEXT="^TMP(""SRHL"","
82 D ^XMD
83 Q
84SET(ECODE,OBR,OBX,SRHLX) ;sets up discrepancy global
85 S ^TMP("SRHL",SRHLX)=ECODE_" at position OBR-"_$P(OBR,HLFS,2)_$S($G(OBX)'="":" OBX-"_$P(OBX,HLFS,2),1:"")_".",SRHLX=SRHLX+1
86 Q
Note: See TracBrowser for help on using the repository browser.