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
Q
;
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)
Q
;
DISPMSH ; EP - Don't process anything in the MSH Segment
Q
;
DISPPID ; EP - Don't process anything in the PID Segment
Q
;
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,!
;
Q
;
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,!
;
Q
;
DISPORC ; EP - Don't process anything in the PID Segment
Q
;
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,!
Q
;
DISPNTE ; EP - Don't process anything in the NTE Segment
Q
;
DISPTQ1 ; EP - Don't process anything in the TQ1 Segment
Q
;
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
Q
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
