SRHLVORU.m

SRHLVORU ;B'HAM ISC/DLR - Surgery Interface Receiver of ORU message ; [ 05/06/98   7:14 AM ]

 ;;3.0; Surgery ;**41**;24 Jun 93

 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 ;processing of incoming ORU message

 ; 1. process MSH - create field separator and other encoding characters

 ; 2. process PID - establish patient IEN

 ; 3. process OBR - create observation identifier and stuff fields

 ;    a. process OBX - using OBR identifier stuff fields

 ;    b. process NTE - using OBR identifier stuff anesthesia comment

 ; 4. use ^TMP("SRHL" global to create a descrepancy report if needed

 ;

 ;  Troubleshooting

 ; What to do if a field is not being added?

 ;  1. View descrepancy message.

 ;  2. Check the Flag Interface Fields option for a receive flag.

 ;  3. Check to see if the field has an input transform.

 ;

REC N DFN,DFN1,HLCOMP,HLREP,HLSUB,II,SG,SRERR,SRI,SRHLX,SSN,TYPE,QOBR

 S QOBR=1 ;flag for stopping OBR segments from being processed

 S UPDATE=0

 S SRHLX=1 K ^TMP("SRHL")

 S SRNOCON=1 ;no concurrent case information

 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

 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) D ^DIE K DR,DO,DIE

EXIT ;

 S HLMTN="ACK",HLSDT=1,SRI=1

 D MSA^SRHLVUO(.SRI,$S($D(HLERR):"AE",1:"AA"))

 I $D(HLERR) D ERR^SRHLVUO(.SRI,.SRERR)

 W:$G(HLERR)'="" !,"ERROR ",$G(HLERR)

 W:$G(HLERR)="" !,"NO ERROR"

 D EN^HLTRANS

 I $D(^TMP("SRHL")) K DIC S DIC="^XMB(3.8,",X="SRHL DISCREPANCY" D ^DIC K DIC Q:Y=-1  D REPORT(HLMID)

 Q

PICK ;check routine for segment entry point

 I $T(@SG)]"" D @SG

 I $T(@SG)="" S HLERR="Invalid segment "_$G(SG)_" in message "_$G(TYPE) Q

 Q

MSH ;process the MSH segment

 S HLFS=$E(MSG,4),HLECH=$E(MSG,5,8)

 S HLCOMP=$E(HLECH,1),HLREP=$E(HLECH,2),HLSUB=$E(HLECH,4)

 S TYPE=$P(MSG,HLFS,9)

 Q

PID ;process PID segment

 N I,PAT,SSN

 S SSN=$P(MSG,HLFS,20),PAT=$$FMNAME^HLFNC($P(MSG,HLFS,6))

 I $G(PAT)'="" F I=0:0 S I=$O(^DPT("B",PAT,I)) Q:'I  S DFN=I

 I $G(SSN)'="" S DFN1=$O(^DPT("SSN",SSN,0))

 I $G(DFN)=""&($G(DFN1)="") S HLERR="Invalid Patient Name or SSN"

 E  I $G(DFN)'=$G(DFN1) S ^TMP("SRHL",SRHLX)=PAT_" does not match SSN, "_SSN_".",SRHLX=SRHLX+1

 Q

OBX ;OBX segments processing

 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

 Q

NTE ;NTE segment processing

 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) D ^DIE K DR,DO

 I '$D(HLERR)&($G(QOBR)'=1)&($D(OBR)) D NTE^SRHLVUI2(MSG,OBR)

 Q

DSC Q

OBR ;OBR segment processing

 I $D(DR)&('$D(HLERR))&($G(QOBR)=0) W !,"OBR DR",DR D ^DIE K DR,DO,DIE

 N CASE,CDFN,ID,IEN

 S QOBR=0

 ;set-up the IDentifier and check the mapping file (#133.2) for a match

 S ID=$P($P(MSG,HLFS,5),HLCOMP,2) I $G(ID)="" S HLERR="Missing OBR identifier" Q

 S IEN=$O(^SRO(133.2,"AC",ID,0)) I $G(IEN)="" D SET("Invalid OBR identifier",OBR,"",.SRHLX) Q

 S CASE=$P(MSG,HLFS,4) I CASE="" S HLERR="NULL Case Number" Q

 I '$D(^SRF(CASE,0)) S HLERR="Invalid Surgery Case Number" Q

 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

 ;get the next OBR segment that is set to receive

 I $$CHECK(IEN)'=1 S QOBR=1 Q

 S (SRTN,DA)=CASE,DIE=$P(^SRO(133.2,IEN,0),U,2)

 ;process the OBR identifier that is set to receive

 I $$CHECK(IEN)=1 S OBR=MSG D:'$D(HLERR) OBR^SRHLVUI(IEN,OBR)

 Q

CHECK(IEN) ;check for valid receivable segments in file 133.2 (Surgery Interface)

 I $G(IEN)="" Q 0

 Q $P($G(^SRO(133.2,IEN,0)),U,4)["R"

REPORT(HLMID) ;creates discrepancy report to be mailed to SR HL7 mailgroup

 S XMSUB="Message #"_HLMID_" contains Surgery application discrepancies."

 S XMY("G.SRHL DISCREPANCY")=""

 S XMTEXT="^TMP(""SRHL"","

 D ^XMD

 Q

SET(ECODE,OBR,OBX,SRHLX) ;sets up discrepancy global

 S ^TMP("SRHL",SRHLX)=ECODE_" at position OBR-"_$P(OBR,HLFS,2)_$S($G(OBX)'="":" OBX-"_$P(OBX,HLFS,2),1:"")_".",SRHLX=SRHLX+1

 Q

SRHLVORU  ;B'HAM ISC/DLR - Surgery Interface Receiver of ORU message ; [ 05/06/98   7:14 AM ]

 +1       ;;3.0; Surgery ;**41**;24 Jun 93

 +2       ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 +3       ;processing of incoming ORU message

 +4       ; 1. process MSH - create field separator and other encoding characters

 +5       ; 2. process PID - establish patient IEN

 +6       ; 3. process OBR - create observation identifier and stuff fields

 +7       ;    a. process OBX - using OBR identifier stuff fields

 +8       ;    b. process NTE - using OBR identifier stuff anesthesia comment

 +9       ; 4. use ^TMP("SRHL" global to create a descrepancy report if needed

 +10      ;

 +11      ;  Troubleshooting

 +12      ; What to do if a field is not being added?

 +13      ;  1. View descrepancy message.

 +14      ;  2. Check the Flag Interface Fields option for a receive flag.

 +15      ;  3. Check to see if the field has an input transform.

 +16      ;

REC        NEW DFN,DFN1,HLCOMP,HLREP,HLSUB,II,SG,SRERR,SRI,SRHLX,SSN,TYPE,QOBR

 +1       ;flag for stopping OBR segments from being processed

           SET QOBR=1

 +2        SET UPDATE=0

 +3        SET SRHLX=1

           KILL ^TMP("SRHL")

 +4       ;no concurrent case information

           SET SRNOCON=1

 +5        SET II=0

           FOR 

               SET II=$ORDER(^HL(772,HLDA,"IN",II))

               IF 'II!$DATA(HLERR)

                   QUIT 

               SET MSG=^HL(772,HLDA,"IN",II,0)

               SET SG=$EXTRACT(^(0),1,3)

               DO PICK

 +6        IF $DATA(DR)&('$DATA(HLERR))&($GET(QOBR)=0)

               DO ^DIE

               KILL DR,DO,DIE

EXIT      ;

 +1        SET HLMTN="ACK"

           SET HLSDT=1

           SET SRI=1

 +2        DO MSA^SRHLVUO(.SRI,$SELECT($DATA(HLERR):"AE",1:"AA"))

 +3        IF $DATA(HLERR)

               DO ERR^SRHLVUO(.SRI,.SRERR)

 +4        IF $GET(HLERR)'=""

               WRITE !,"ERROR ",$GET(HLERR)

 +5        IF $GET(HLERR)=""

               WRITE !,"NO ERROR"

 +6        DO EN^HLTRANS

 +7        IF $DATA(^TMP("SRHL"))

               KILL DIC

               SET DIC="^XMB(3.8,"

               SET X="SRHL DISCREPANCY"

               DO ^DIC

               KILL DIC

               IF Y=-1

                   QUIT 

               DO REPORT(HLMID)

 +8        QUIT 

PICK      ;check routine for segment entry point

 +1        IF $TEXT(@SG)]""

               DO @SG

 +2        IF $TEXT(@SG)=""

               SET HLERR="Invalid segment "_$GET(SG)_" in message "_$GET(TYPE)

               QUIT 

 +3        QUIT 

MSH       ;process the MSH segment

 +1        SET HLFS=$EXTRACT(MSG,4)

           SET HLECH=$EXTRACT(MSG,5,8)

 +2        SET HLCOMP=$EXTRACT(HLECH,1)

           SET HLREP=$EXTRACT(HLECH,2)

           SET HLSUB=$EXTRACT(HLECH,4)

 +3        SET TYPE=$PIECE(MSG,HLFS,9)

 +4        QUIT 

PID       ;process PID segment

 +1        NEW I,PAT,SSN

 +2        SET SSN=$PIECE(MSG,HLFS,20)

           SET PAT=$$FMNAME^HLFNC($PIECE(MSG,HLFS,6))

 +3        IF $GET(PAT)'=""

               FOR I=0:0

                   SET I=$ORDER(^DPT("B",PAT,I))

                   IF 'I

                       QUIT 

                   SET DFN=I

 +4        IF $GET(SSN)'=""

               SET DFN1=$ORDER(^DPT("SSN",SSN,0))

 +5        IF $GET(DFN)=""&($GET(DFN1)="")

               SET HLERR="Invalid Patient Name or SSN"

 +6       IF '$TEST

               IF $GET(DFN)'=$GET(DFN1)

                   SET ^TMP("SRHL",SRHLX)=PAT_" does not match SSN, "_SSN_"."

                   SET SRHLX=SRHLX+1

 +7        QUIT 

OBX       ;OBX segments processing

 +1        IF '$DATA(HLERR)&($GET(QOBR)=0)

               IF '$DATA(DR)&($DATA(OBR))

                   DO OBR^SRHLVUI("",OBR)

               DO OBX^SRHLVUI2(MSG,OBR)

               IF UPDATE=1

                   WRITE !,"DR ",DR

                   DO ^DIE

                   KILL DR,DO

                   SET UPDATE=0

 +2        QUIT 

NTE       ;NTE segment processing

 +1        IF $DATA(DR)&('$DATA(HLERR))&($GET(QOBR)=0)

               DO ^DIE

               KILL DR,DO

 +2        IF '$DATA(HLERR)&($GET(QOBR)'=1)&($DATA(OBR))

               DO NTE^SRHLVUI2(MSG,OBR)

 +3        QUIT 

DSC        QUIT 

OBR       ;OBR segment processing

 +1        IF $DATA(DR)&('$DATA(HLERR))&($GET(QOBR)=0)

               WRITE !,"OBR DR",DR

               DO ^DIE

               KILL DR,DO,DIE

 +2        NEW CASE,CDFN,ID,IEN

 +3        SET QOBR=0

 +4       ;set-up the IDentifier and check the mapping file (#133.2) for a match

 +5        SET ID=$PIECE($PIECE(MSG,HLFS,5),HLCOMP,2)

           IF $GET(ID)=""

               SET HLERR="Missing OBR identifier"

               QUIT 

 +6        SET IEN=$ORDER(^SRO(133.2,"AC",ID,0))

           IF $GET(IEN)=""

               DO SET("Invalid OBR identifier",OBR,"",.SRHLX)

               QUIT 

 +7        SET CASE=$PIECE(MSG,HLFS,4)

           IF CASE=""

               SET HLERR="NULL Case Number"

               QUIT 

 +8        IF '$DATA(^SRF(CASE,0))

               SET HLERR="Invalid Surgery Case Number"

               QUIT 

 +9        IF $DATA(^SRF(CASE,0))

               SET CDFN=$PIECE(^SRF(CASE,0),U)

               IF CDFN'=$GET(DFN)&((CDFN'=$GET(DFN1)))

                   SET HLERR="Mismatch of PID patient and Case patient"

                   QUIT 

 +10      ;get the next OBR segment that is set to receive

 +11       IF $$CHECK(IEN)'=1

               SET QOBR=1

               QUIT 

 +12       SET (SRTN,DA)=CASE

           SET DIE=$PIECE(^SRO(133.2,IEN,0),U,2)

 +13      ;process the OBR identifier that is set to receive

 +14       IF $$CHECK(IEN)=1

               SET OBR=MSG

               IF '$DATA(HLERR)

                   DO OBR^SRHLVUI(IEN,OBR)

 +15       QUIT 

CHECK(IEN) ;check for valid receivable segments in file 133.2 (Surgery Interface)

 +1        IF $GET(IEN)=""

               QUIT 0

 +2        QUIT $PIECE($GET(^SRO(133.2,IEN,0)),U,4)["R"

REPORT(HLMID) ;creates discrepancy report to be mailed to SR HL7 mailgroup

 +1        SET XMSUB="Message #"_HLMID_" contains Surgery application discrepancies."

 +2        SET XMY("G.SRHL DISCREPANCY")=""

 +3        SET XMTEXT="^TMP(""SRHL"","

 +4        DO ^XMD

 +5        QUIT 

SET(ECODE,OBR,OBX,SRHLX) ;sets up discrepancy global

 +1        SET ^TMP("SRHL",SRHLX)=ECODE_" at position OBR-"_$PIECE(OBR,HLFS,2)_$SELECT($GET(OBX)'="":" OBX-"_$PIECE(OBX,HLFS,2),1:"")_"."

           SET SRHLX=SRHLX+1

 +2        QUIT