Routine: BLRRLMUA

BLRRLMUA ; IHS/MSC/MKK - Reference Lab Meaningful use Utilities, Part A  ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997

EEP ; Ersatz EP

 D EEP^BLRGMENU

MU2TEST ; Test of code that reads INCOMING HL7 message

 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRUID,U,XPARSYS,XQXFLG)

 S DIR(0)="NO"

 S DIR("A")="Enter UID:"

 D ^DIR

 I +$G(DIRUT) D ENDMESG^BLRRLMU2("No/Invalid Entry.  Routine Ends.")  Q

 S LRUID=X

 I $D(^LRO(68,"C",$P(LRUID,"A")))<1 D ENDMESG^BLRRLMU2("No Accessfion File Data.  Routine Ends.")  Q     ; Skip if no UID data

 S X=$Q(^LRO(68,"C",$P(LRUID,"A"),0))

 S LRAA=$QS(X,4),LRAD=$QS(X,5),LRAN=$QS(X,6)

 S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRIDT=$P($G(^(3)),"^",5)

 S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")

 W !!,"LRUID:",LRUID,!

 W ?4,"LRAA:",LRAA,?19,"LRAD:",LRAD,?34,"LRAN:",LRAN,?49,"LRAS:",$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),!!

 K ^TMP("BLRRLMUU",$J,LRUID)                       ; DEBUG - Reset everything

 S PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)                 ; Store HL7 data in ^TMP

 I PIEN<1 D ENDMESG^BLRRLMU2("No Information for PID "_LRUID_" found in 62.49.  Routine Ends.")  Q

 W "FILE 62.49 -- PIEN:",PIEN,!!

 ; Display the various HL7 segments' data

 S SEG=""

 F  S SEG=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG))  Q:SEG=""  D

 . S SEGIEN=0

 . F  S SEGIEN=$O(^TMP("BLRRLMUU",$J,LRUID,PIEN,SEG,SEGIEN))  Q:SEGIEN<1  D SHOWSEG

 D PRESSKEY^BLRGMENU(9)

DISPMSH ; EP - Don't process anything in the MSH Segment

DISPPID ; EP - Don't process anything in the PID Segment

DISPOBR ; EP

 NEW CHNGDTT,DATANAME,DNDTT,F60IEN,OBRIEN,OBSDTT,RCTOSTR,TESTNAME,TSTLOINC

 S TSTLOINC=$P($P(STR,"|",5),"^")

 S TESTNAME=$P($P(STR,"|",5),"^",2)

 S ORIGTEXT=$P($P(STR,"|",5),"^",9)

 W ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"

 W:$L(TESTNAME)<31 TESTNAME,!

 I $L(TESTNAME)>30 D LINEWRAP^BLRGMENU(49,TESTNAME,30)  W !

 W ?9,"ORIGTEXT:",ORIGTEXT,!

 S F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")

 W ?9,"F60IEN:",F60IEN,!

 S DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")

 W ?9,"DATANAME:",DATANAME,!

 S OBSDTT=$P($P(STR,"|",8),"^")               ; Observation Date/Time

 W ?9,"OBSDTT:",OBSDTT

 D:$L(OBSDTT) SHOWDATE^BLRRLMU2(OBSDTT)

W !

 S CHNGDTT=$P($P(STR,"|",23),"^")             ; Status/Result Change Date/Time

 W ?9,"CHNGDTT:",CHNGDTT

 D:$L(CHNGDTT) SHOWDATE^BLRRLMU2(CHNGDTT)

W !

 S DNDTT=$S($L(CHNGDTT):CHNGDTT,1:OBSDTT)     ; DataName Date/Time

 W ?9,"DNDTT:",DNDTT

 D:$L(DNDTT) SHOWDATE^BLRRLMU2(CHNGDTT)

W !

 S RCTOSTR=$P(STR,"|",29)                     ; Result Copies To

 I $L(RCTOSTR) D

 . S SUBSTR2=$TR($P(RCTOSTR,"^",2,6),"^"," ")

 . Q:$L($TR(SUBSTR2," "))<1                   ; If only spaces, skip

. ;

 . W ?9,"RCTOSTR:",RCTOSTR,!,?14,"SUBSTR2:",SUBSTR2,!

. ;

 . ; Assumption is that the NAME is in $P(SUBSTR," ",1,3)

 . S SUBSTR2=$P(SUBSTR2," ")_","_$P(SUBSTR2," ",2,$L(SUBSTR2," "))

 . W ?19,"SUBSTR2:",SUBSTR2,!

DISPOBX ; EP

 NEW ANSDTT,DATANAME,F60IEN,OBRIEN,STATUS,TESTNAME,TSTLOINC

 S TSTLOINC=$P($P(STR,"|",4),"^")

 S TESTNAME=$P($P(STR,"|",4),"^",2)

 S ORIGTEXT=$P($P(STR,"|",4),"^",9)

 W ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"

 W:$L(TESTNAME)<31 TESTNAME,!

 I $L(TESTNAME)>30 D LINEWRAP^BLRGMENU(49,TESTNAME,30)  W !

 W ?9,"ORIGTEXT:",ORIGTEXT,!

 S F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")

 W ?9,"F60IEN:",F60IEN,!

 S DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")

 W ?9,"DATANAME:",DATANAME,!

 S ANSDTT=$P($P(STR,"|",15),"^")               ; Analysis Date/Time

 W ?9,"ANSDTT:",ANSDTT

 D:$L(ANSDTT) SHOWDATE^BLRRLMU2(ANSDTT)

W !

 S STATUS=$P(STR,"|",12)

 W ?9,"STATUS:",STATUS,!

DISPORC ; EP - Don't process anything in the PID Segment

DISPSPM ; EP

 NEW CONDSPEC,SPMIEN

 S CONDSPEC=$P($P(STR,"|",25),"^")            ; SPECIMEN CONDITION

 W ?9,"CONDSPEC:",CONDSPEC,!

 S REJREASN=$P($P(STR,"|",22),"^",2)

 W ?9,"REJREASN:",REJREASN,!

DISPNTE ; EP - Don't process anything in the NTE Segment

DISPTQ1 ; EP - Don't process anything in the TQ1 Segment

SHOWSEG ; EP - Show segment and setup STR variable

 NEW STR

 W ?4,SEG,!,?9,"PIEN:",PIEN,?39,"SEGIEN:",SEGIEN,!

 S STR=$G(^LAHM(62.49,PIEN,150,SEGIEN,0))

 S DOTELL="DISP"_SEG

 D @DOTELL

BLRRLMUA  ; IHS/MSC/MKK - Reference Lab Meaningful use Utilities, Part A  ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997

 +2       ;

EEP       ; Ersatz EP

 +1        DO EEP^BLRGMENU

 +2        QUIT

 +3       ;

MU2TEST   ; Test of code that reads INCOMING HL7 message

 +1        NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRUID,U,XPARSYS,XQXFLG)

 +2       ;

 +3        SET DIR(0)="NO"

 +4        SET DIR("A")="Enter UID:"

 +5        DO ^DIR

 +6        IF +$GET(DIRUT)

               DO ENDMESG^BLRRLMU2("No/Invalid Entry.  Routine Ends.")

               QUIT

 +7       ;

 +8        SET LRUID=X

 +9       ;

 +10      ; Skip if no UID data

           IF $DATA(^LRO(68,"C",$PIECE(LRUID,"A")))<1

               DO ENDMESG^BLRRLMU2("No Accessfion File Data.  Routine Ends.")

               QUIT

 +11      ;

 +12       SET X=$QUERY(^LRO(68,"C",$PIECE(LRUID,"A"),0))

 +13       SET LRAA=$QSUBSCRIPT(X,4)

           SET LRAD=$QSUBSCRIPT(X,5)

           SET LRAN=$QSUBSCRIPT(X,6)

 +14      ;

 +15       SET LRDFN=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

           SET LRIDT=$PIECE($GET(^(3)),"^",5)

 +16       SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")

 +17      ;

 +18       WRITE !!,"LRUID:",LRUID,!

 +19       WRITE ?4,"LRAA:",LRAA,?19,"LRAD:",LRAD,?34,"LRAN:",LRAN,?49,"LRAS:",$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),!!

 +20      ;

 +21      ; DEBUG - Reset everything

           KILL ^TMP("BLRRLMUU",$JOB,LRUID)

 +22      ;

 +23      ; Store HL7 data in ^TMP

           SET PIEN=$$SHL7SEGS^BLRRLMUU(LRUID)

 +24      ;

 +25       IF PIEN<1

               DO ENDMESG^BLRRLMU2("No Information for PID "_LRUID_" found in 62.49.  Routine Ends.")

               QUIT

 +26      ;

 +27       WRITE "FILE 62.49 -- PIEN:",PIEN,!!

 +28      ;

 +29      ; Display the various HL7 segments' data

 +30       SET SEG=""

 +31       FOR

               SET SEG=$ORDER(^TMP("BLRRLMUU",$JOB,LRUID,PIEN,SEG))

               IF SEG=""

                   QUIT

               Begin DoDot:1

 +32               SET SEGIEN=0

 +33               FOR

                       SET SEGIEN=$ORDER(^TMP("BLRRLMUU",$JOB,LRUID,PIEN,SEG,SEGIEN))

                       IF SEGIEN<1

                           QUIT

                       DO SHOWSEG

               End DoDot:1

 +34      ;

 +35       DO PRESSKEY^BLRGMENU(9)

 +36       QUIT

 +37      ;

DISPMSH   ; EP - Don't process anything in the MSH Segment

 +1        QUIT

 +2       ;

DISPPID   ; EP - Don't process anything in the PID Segment

 +1        QUIT

 +2       ;

DISPOBR   ; EP

 +1        NEW CHNGDTT,DATANAME,DNDTT,F60IEN,OBRIEN,OBSDTT,RCTOSTR,TESTNAME,TSTLOINC

 +2       ;

 +3        SET TSTLOINC=$PIECE($PIECE(STR,"|",5),"^")

 +4        SET TESTNAME=$PIECE($PIECE(STR,"|",5),"^",2)

 +5        SET ORIGTEXT=$PIECE($PIECE(STR,"|",5),"^",9)

 +6       ;

 +7        WRITE ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"

 +8        IF $LENGTH(TESTNAME)<31

               WRITE TESTNAME,!

 +9        IF $LENGTH(TESTNAME)>30

               DO LINEWRAP^BLRGMENU(49,TESTNAME,30)

               WRITE !

 +10       WRITE ?9,"ORIGTEXT:",ORIGTEXT,!

 +11      ;

 +12       SET F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")

 +13       WRITE ?9,"F60IEN:",F60IEN,!

 +14      ;

 +15       SET DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")

 +16       WRITE ?9,"DATANAME:",DATANAME,!

 +17      ;

 +18      ; Observation Date/Time

           SET OBSDTT=$PIECE($PIECE(STR,"|",8),"^")

 +19       WRITE ?9,"OBSDTT:",OBSDTT

 +20       IF $LENGTH(OBSDTT)

               DO SHOWDATE^BLRRLMU2(OBSDTT)

 +21       WRITE !

 +22      ;

 +23      ; Status/Result Change Date/Time

           SET CHNGDTT=$PIECE($PIECE(STR,"|",23),"^")

 +24       WRITE ?9,"CHNGDTT:",CHNGDTT

 +25       IF $LENGTH(CHNGDTT)

               DO SHOWDATE^BLRRLMU2(CHNGDTT)

 +26       WRITE !

 +27      ;

 +28      ; DataName Date/Time

           SET DNDTT=$SELECT($LENGTH(CHNGDTT):CHNGDTT,1:OBSDTT)

 +29       WRITE ?9,"DNDTT:",DNDTT

 +30       IF $LENGTH(DNDTT)

               DO SHOWDATE^BLRRLMU2(CHNGDTT)

 +31       WRITE !

 +32      ;

 +33      ; Result Copies To

           SET RCTOSTR=$PIECE(STR,"|",29)

 +34       IF $LENGTH(RCTOSTR)

               Begin DoDot:1

 +35               SET SUBSTR2=$TRANSLATE($PIECE(RCTOSTR,"^",2,6),"^"," ")

 +36      ; If only spaces, skip

                   IF $LENGTH($TRANSLATE(SUBSTR2," "))<1

                       QUIT

 +37      ;

 +38               WRITE ?9,"RCTOSTR:",RCTOSTR,!,?14,"SUBSTR2:",SUBSTR2,!

 +39      ;

 +40      ; Assumption is that the NAME is in $P(SUBSTR," ",1,3)

 +41               SET SUBSTR2=$PIECE(SUBSTR2," ")_","_$PIECE(SUBSTR2," ",2,$LENGTH(SUBSTR2," "))

 +42               WRITE ?19,"SUBSTR2:",SUBSTR2,!

               End DoDot:1

 +43      ;

 +44       QUIT

 +45      ;

DISPOBX   ; EP

 +1        NEW ANSDTT,DATANAME,F60IEN,OBRIEN,STATUS,TESTNAME,TSTLOINC

 +2       ;

 +3        SET TSTLOINC=$PIECE($PIECE(STR,"|",4),"^")

 +4        SET TESTNAME=$PIECE($PIECE(STR,"|",4),"^",2)

 +5        SET ORIGTEXT=$PIECE($PIECE(STR,"|",4),"^",9)

 +6       ;

 +7        WRITE ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"

 +8        IF $LENGTH(TESTNAME)<31

               WRITE TESTNAME,!

 +9        IF $LENGTH(TESTNAME)>30

               DO LINEWRAP^BLRGMENU(49,TESTNAME,30)

               WRITE !

 +10       WRITE ?9,"ORIGTEXT:",ORIGTEXT,!

 +11      ;

 +12       SET F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")

 +13       WRITE ?9,"F60IEN:",F60IEN,!

 +14      ;

 +15       SET DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")

 +16       WRITE ?9,"DATANAME:",DATANAME,!

 +17      ;

 +18      ; Analysis Date/Time

           SET ANSDTT=$PIECE($PIECE(STR,"|",15),"^")

 +19       WRITE ?9,"ANSDTT:",ANSDTT

 +20       IF $LENGTH(ANSDTT)

               DO SHOWDATE^BLRRLMU2(ANSDTT)

 +21       WRITE !

 +22      ;

 +23       SET STATUS=$PIECE(STR,"|",12)

 +24       WRITE ?9,"STATUS:",STATUS,!

 +25      ;

 +26       QUIT

 +27      ;

DISPORC   ; EP - Don't process anything in the PID Segment

 +1        QUIT

 +2       ;

DISPSPM   ; EP

 +1        NEW CONDSPEC,SPMIEN

 +2       ;

 +3       ; SPECIMEN CONDITION

           SET CONDSPEC=$PIECE($PIECE(STR,"|",25),"^")

 +4        WRITE ?9,"CONDSPEC:",CONDSPEC,!

 +5       ;

 +6        SET REJREASN=$PIECE($PIECE(STR,"|",22),"^",2)

 +7        WRITE ?9,"REJREASN:",REJREASN,!

 +8        QUIT

 +9       ;

DISPNTE   ; EP - Don't process anything in the NTE Segment

 +1        QUIT

 +2       ;

DISPTQ1   ; EP - Don't process anything in the TQ1 Segment

 +1        QUIT

 +2       ;

SHOWSEG   ; EP - Show segment and setup STR variable

 +1        NEW STR

 +2       ;

 +3        WRITE ?4,SEG,!,?9,"PIEN:",PIEN,?39,"SEGIEN:",SEGIEN,!

 +4        SET STR=$GET(^LAHM(62.49,PIEN,150,SEGIEN,0))

 +5        SET DOTELL="DISP"_SEG

 +6        DO @DOTELL

 +7        QUIT

BLRRLMUA.m