BLRRLMU4 ; IHS/MSC/MKK - Reference Lab Meaningful use Utilities, Part 4 ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
PEP ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S BLRVERN=$TR($P($T(+1),";")," ")
;
D ADDTMENU^BLRGMENU("UNIVERSE^BLRRLMU4","UIDs Report")
D ADDTMENU^BLRGMENU("UNIVERUD^BLRRLMU4","Enter UID & Display HL7 Segs")
;
; Main Menu driver
D MENUDRVR^BLRGMENU("RPMS Lab MU Stage 2","Miscellaneous Debug Utilities",$$CJ^XLFSTR("Universal Interface (#4001) File Reports",IOM))
Q
;
UNIVERSE ; EP - Universal Interface UIDs Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D UNIVERSI
;
F S MSGNUM=$O(^INTHU("AD",WOTREF,MSGNUM),-1) Q:MSGNUM<1!(QFLG="Q") D
. S DATETIME=$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(4001,MSGNUM,.01,"I"),"5MPZ"))
. S DATETIME=$P(DATETIME," ")_$J($P(DATETIME," ",2,3),9)
. S (MSGSEG,NOTMSG)=0
. F S MSGSEG=$O(^INTHU(MSGNUM,3,MSGSEG)) Q:MSGSEG<1!(QFLG="Q") D
.. I $P($G(^INTHU(MSGNUM,3,MSGSEG,0)),"|")="OBR" D
... S UID=$P($G(^INTHU(MSGNUM,3,MSGSEG,0)),"|",3)
... Q:$L(UID)<1
... I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO") Q:QFLG="Q"
... ;
... W ?4,MSGNUM,?19,DATETIME,?40,MSGSEG,?50,$P(UID,"^"),?65,$P(UID,"^",2),!
... S LINES=LINES+1
;
D PRESSKEY^BLRGMENU(9)
Q
;
UNIVERSI ; EP - Initialization
S BLRVERN=$TR($P($T(+1),";")," ")
S BLVERN2="UNIVERSE"
;
S WOTREF=+$$FIND1^DIC(4005,,,"HL IHS LAB R01 MU IN")
Q:WOTREF<1 0 ; Quit with zero if IEN<1
;
S HEADER(1)="UNIVERSAL INTERFACE"
S HEADER(2)="Incoming Interface: HL IHS LAB R01 MU IN"
S HEADER(3)=" "
S $E(HEADER(4),5)="Message #"
S $E(HEADER(4),22)="Date"
S $E(HEADER(4),32)="Time"
S $E(HEADER(4),41)="Seg #"
S $E(HEADER(4),51)="UID"
S $E(HEADER(4),66)="'$P(UID,""^"",2)'"
;
S FOUNDIT=0
S (CNT,PG)=0
S QFLG="NO"
S MAXLINES=20,LINES=MAXLINES+10
S MSGNUM="AAA"
Q
;
UNIVERUD ; EP - For UNIVERSAL INTERFACE, Enter UID & Display ALL HL7 Segs
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S BLRVERN=$TR($P($T(+1),";")," ")
;
S WOTREF=+$$FIND1^DIC(4005,,,"HL IHS LAB R01 MU IN")
;
I WOTREF<1 D Q
. W !,?4,"Could not determine IEN of 'HL IHS LAB R01 MU IN' Interface. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
D ^XBFMK
S DIR(0)="NO"
S DIR("A")="Enter UID"
D ^DIR
I +$G(DIRUT) D Q
. W !!,?4,"No/Invalid Entry. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
S LRUID=X
W !!,"LRUID:",LRUID,!,?4,"Searching"
;
S MSGNUM="AAA",FOUNDIT=0
F S MSGNUM=$O(^INTHU("AD",WOTREF,MSGNUM),-1) Q:MSGNUM<1!(FOUNDIT) D
. S DATETIME=$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(4001,MSGNUM,.01,"I"),"5MPZ"))
. S (MSGSEG,NOTMSG)=0
. W "." W:$X>74 !,?4
. F S MSGSEG=$O(^INTHU(MSGNUM,3,MSGSEG)) Q:MSGSEG<1!(FOUNDIT) D
.. I $P($G(^INTHU(MSGNUM,3,MSGSEG,0)),"|")="OBR" D
... S UID=$P($P($G(^INTHU(MSGNUM,3,MSGSEG,0)),"|",3),"^")
... S:UID=LRUID FOUNDIT=MSGNUM
;
;
W !!
I FOUNDIT<1 D Q
. W ?4,"Could not find UID ",LRUID," in File 4001. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
I FOUNDIT W ?4,"Found UID ",LRUID," in File 4001 at MSGNUM:",FOUNDIT
D PRESSKEY^BLRGMENU(9)
;
W !!
;
S MAXLINES=IOSL-4
S LINES=MAXLINES+10
S (CNT,PG,UID6249)=0
S (HDRONE,QFLG)="NO"
S BLRVERN="BLRRLMU4",BLRVERN2="UNIVERUD"
S HEADER(1)="UNIVERSAL INTERFACE"
S HEADER(2)="UID "_LRUID_" HL7 Segments"
; S HEADER(3)=" "
;
; Display the various HL7 segments' data
D HEADERDT^BLRGMENU
S SEGIEN=.9999999
F S SEGIEN=$O(^INTHU(FOUNDIT,3,SEGIEN)) Q:SEGIEN<1!(QFLG="Q") D
. S SEG=$P($G(^INTHU(FOUNDIT,3,SEGIEN,0)),"|")
. Q:$L(SEG)>3
. S DOTELL="DISP"_SEG
. D @DOTELL
;
D PRESSKEY^BLRGMENU(9)
Q
;
DISPMSH ; EP - Don't process anything in the MSH Segment
NEW STR
D SHOWSEG
Q
;
DISPPID ; EP - Don't process anything in the PID Segment
NEW STR
D SHOWSEG
Q
;
DISPOBR ; EP
NEW CHNGDTT,DATANAME,DNDTT,F60IEN,OBRIEN,OBSDTT,RCTOSTR,STR,TESTNAME,TSTLOINC
;
D SHOWSEG
;
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(OBSDTT)
W !
;
S CHNGDTT=$P($P(STR,"|",23),"^") ; Status/Result Change Date/Time
W ?9,"CHNGDTT:",CHNGDTT
D:$L(CHNGDTT) SHOWDATE(CHNGDTT)
W !
;
S DNDTT=$S($L(CHNGDTT):CHNGDTT,1:OBSDTT) ; DataName Date/Time
W ?9,"DNDTT:",DNDTT
D:$L(DNDTT) SHOWDATE(DNDTT)
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
;
SHOWSEG ; EP - Show segment and setup STR variable
W ?4,SEG,!,?9,"FOUNDIT:",FOUNDIT,?39,"SEGIEN:",SEGIEN,!
S STR=$G(^INTHU(FOUNDIT,3,SEGIEN,0))
Q
;
SHOWDATE(HL7DT) ; EP - Take HL7 Date and display FM & External Date
NEW FMDT
;
S TAB=$G(TAB,9)
S FMDT=$$HL7TFM^XLFDT(HL7DT)
W ?39,FMDT
W ?59,$$FMTE^XLFDT(FMDT,"5MZ")
Q
;
DISPOBX ; EP
NEW ANSDTT,DATANAME,F60IEN,OBRIEN,STATUS,STR,TESTNAME,TSTLOINC
;
D SHOWSEG
;
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(ANSDTT)
W !
;
S STATUS=$P(STR,"|",12)
W ?9,"STATUS:",STATUS,!
;
Q
;
DISPORC ; EP - Don't process anything in the PID Segment
NEW STR
D SHOWSEG
Q
;
DISPSPM ; EP
NEW CONDSPEC,SPMIEN,STR
;
D SHOWSEG
;
S CONDSPEC=$P($P(STR,"|",25),"^") ; SPECIMEN CONDITION
W ?9,"CONDSPEC:",CONDSPEC,!
;
S REJREASN=$P($P(STR,"|",22),"^",2) ; REJECTION REASON
W ?9,"REJREASN:",REJREASN,!
Q
;
DISPNTE ; EP - Don't process anything in the NTE Segment
NEW STR
D SHOWSEG
Q
;
DISPTQ1 ; EP - Don't process anything in the TQ1 Segment
NEW STR
D SHOWSEG
Q
BLRRLMU4 ; IHS/MSC/MKK - Reference Lab Meaningful use Utilities, Part 4 ; 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 ;
PEP ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+4 ;
+5 DO ADDTMENU^BLRGMENU("UNIVERSE^BLRRLMU4","UIDs Report")
+6 DO ADDTMENU^BLRGMENU("UNIVERUD^BLRRLMU4","Enter UID & Display HL7 Segs")
+7 ;
+8 ; Main Menu driver
+9 DO MENUDRVR^BLRGMENU("RPMS Lab MU Stage 2","Miscellaneous Debug Utilities",$$CJ^XLFSTR("Universal Interface (#4001) File Reports",IOM))
+10 QUIT
+11 ;
UNIVERSE ; EP - Universal Interface UIDs Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO UNIVERSI
+4 ;
+5 FOR
SET MSGNUM=$ORDER(^INTHU("AD",WOTREF,MSGNUM),-1)
IF MSGNUM<1!(QFLG="Q")
QUIT
Begin DoDot:1
+6 SET DATETIME=$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(4001,MSGNUM,.01,"I"),"5MPZ"))
+7 SET DATETIME=$PIECE(DATETIME," ")_$JUSTIFY($PIECE(DATETIME," ",2,3),9)
+8 SET (MSGSEG,NOTMSG)=0
+9 FOR
SET MSGSEG=$ORDER(^INTHU(MSGNUM,3,MSGSEG))
IF MSGSEG<1!(QFLG="Q")
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^INTHU(MSGNUM,3,MSGSEG,0)),"|")="OBR"
Begin DoDot:3
+11 SET UID=$PIECE($GET(^INTHU(MSGNUM,3,MSGSEG,0)),"|",3)
+12 IF $LENGTH(UID)<1
QUIT
+13 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,"NO")
IF QFLG="Q"
QUIT
+14 ;
+15 WRITE ?4,MSGNUM,?19,DATETIME,?40,MSGSEG,?50,$PIECE(UID,"^"),?65,$PIECE(UID,"^",2),!
+16 SET LINES=LINES+1
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 DO PRESSKEY^BLRGMENU(9)
+19 QUIT
+20 ;
UNIVERSI ; EP - Initialization
+1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+2 SET BLVERN2="UNIVERSE"
+3 ;
+4 SET WOTREF=+$$FIND1^DIC(4005,,,"HL IHS LAB R01 MU IN")
+5 ; Quit with zero if IEN<1
IF WOTREF<1
QUIT 0
+6 ;
+7 SET HEADER(1)="UNIVERSAL INTERFACE"
+8 SET HEADER(2)="Incoming Interface: HL IHS LAB R01 MU IN"
+9 SET HEADER(3)=" "
+10 SET $EXTRACT(HEADER(4),5)="Message #"
+11 SET $EXTRACT(HEADER(4),22)="Date"
+12 SET $EXTRACT(HEADER(4),32)="Time"
+13 SET $EXTRACT(HEADER(4),41)="Seg #"
+14 SET $EXTRACT(HEADER(4),51)="UID"
+15 SET $EXTRACT(HEADER(4),66)="'$P(UID,""^"",2)'"
+16 ;
+17 SET FOUNDIT=0
+18 SET (CNT,PG)=0
+19 SET QFLG="NO"
+20 SET MAXLINES=20
SET LINES=MAXLINES+10
+21 SET MSGNUM="AAA"
+22 QUIT
+23 ;
UNIVERUD ; EP - For UNIVERSAL INTERFACE, Enter UID & Display ALL HL7 Segs
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+4 ;
+5 SET WOTREF=+$$FIND1^DIC(4005,,,"HL IHS LAB R01 MU IN")
+6 ;
+7 IF WOTREF<1
Begin DoDot:1
+8 WRITE !,?4,"Could not determine IEN of 'HL IHS LAB R01 MU IN' Interface. Routine Ends."
+9 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+10 ;
+11 DO ^XBFMK
+12 SET DIR(0)="NO"
+13 SET DIR("A")="Enter UID"
+14 DO ^DIR
+15 IF +$GET(DIRUT)
Begin DoDot:1
+16 WRITE !!,?4,"No/Invalid Entry. Routine Ends."
+17 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+18 ;
+19 SET LRUID=X
+20 WRITE !!,"LRUID:",LRUID,!,?4,"Searching"
+21 ;
+22 SET MSGNUM="AAA"
SET FOUNDIT=0
+23 FOR
SET MSGNUM=$ORDER(^INTHU("AD",WOTREF,MSGNUM),-1)
IF MSGNUM<1!(FOUNDIT)
QUIT
Begin DoDot:1
+24 SET DATETIME=$$UP^XLFSTR($$FMTE^XLFDT($$GET1^DIQ(4001,MSGNUM,.01,"I"),"5MPZ"))
+25 SET (MSGSEG,NOTMSG)=0
+26 WRITE "."
IF $X>74
WRITE !,?4
+27 FOR
SET MSGSEG=$ORDER(^INTHU(MSGNUM,3,MSGSEG))
IF MSGSEG<1!(FOUNDIT)
QUIT
Begin DoDot:2
+28 IF $PIECE($GET(^INTHU(MSGNUM,3,MSGSEG,0)),"|")="OBR"
Begin DoDot:3
+29 SET UID=$PIECE($PIECE($GET(^INTHU(MSGNUM,3,MSGSEG,0)),"|",3),"^")
+30 IF UID=LRUID
SET FOUNDIT=MSGNUM
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ;
+33 WRITE !!
+34 IF FOUNDIT<1
Begin DoDot:1
+35 WRITE ?4,"Could not find UID ",LRUID," in File 4001. Routine Ends."
+36 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+37 ;
+38 IF FOUNDIT
WRITE ?4,"Found UID ",LRUID," in File 4001 at MSGNUM:",FOUNDIT
+39 DO PRESSKEY^BLRGMENU(9)
+40 ;
+41 WRITE !!
+42 ;
+43 SET MAXLINES=IOSL-4
+44 SET LINES=MAXLINES+10
+45 SET (CNT,PG,UID6249)=0
+46 SET (HDRONE,QFLG)="NO"
+47 SET BLRVERN="BLRRLMU4"
SET BLRVERN2="UNIVERUD"
+48 SET HEADER(1)="UNIVERSAL INTERFACE"
+49 SET HEADER(2)="UID "_LRUID_" HL7 Segments"
+50 ; S HEADER(3)=" "
+51 ;
+52 ; Display the various HL7 segments' data
+53 DO HEADERDT^BLRGMENU
+54 SET SEGIEN=.9999999
+55 FOR
SET SEGIEN=$ORDER(^INTHU(FOUNDIT,3,SEGIEN))
IF SEGIEN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+56 SET SEG=$PIECE($GET(^INTHU(FOUNDIT,3,SEGIEN,0)),"|")
+57 IF $LENGTH(SEG)>3
QUIT
+58 SET DOTELL="DISP"_SEG
+59 DO @DOTELL
End DoDot:1
+60 ;
+61 DO PRESSKEY^BLRGMENU(9)
+62 QUIT
+63 ;
DISPMSH ; EP - Don't process anything in the MSH Segment
+1 NEW STR
+2 DO SHOWSEG
+3 QUIT
+4 ;
DISPPID ; EP - Don't process anything in the PID Segment
+1 NEW STR
+2 DO SHOWSEG
+3 QUIT
+4 ;
DISPOBR ; EP
+1 NEW CHNGDTT,DATANAME,DNDTT,F60IEN,OBRIEN,OBSDTT,RCTOSTR,STR,TESTNAME,TSTLOINC
+2 ;
+3 DO SHOWSEG
+4 ;
+5 SET TSTLOINC=$PIECE($PIECE(STR,"|",5),"^")
+6 SET TESTNAME=$PIECE($PIECE(STR,"|",5),"^",2)
+7 SET ORIGTEXT=$PIECE($PIECE(STR,"|",5),"^",9)
+8 ;
+9 WRITE ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"
+10 IF $LENGTH(TESTNAME)<31
WRITE TESTNAME,!
+11 IF $LENGTH(TESTNAME)>30
DO LINEWRAP^BLRGMENU(49,TESTNAME,30)
WRITE !
+12 WRITE ?9,"ORIGTEXT:",ORIGTEXT,!
+13 ;
+14 SET F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")
+15 WRITE ?9,"F60IEN:",F60IEN,!
+16 ;
+17 SET DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")
+18 WRITE ?9,"DATANAME:",DATANAME,!
+19 ;
+20 ; Observation Date/Time
SET OBSDTT=$PIECE($PIECE(STR,"|",8),"^")
+21 WRITE ?9,"OBSDTT:",OBSDTT
+22 IF $LENGTH(OBSDTT)
DO SHOWDATE(OBSDTT)
+23 WRITE !
+24 ;
+25 ; Status/Result Change Date/Time
SET CHNGDTT=$PIECE($PIECE(STR,"|",23),"^")
+26 WRITE ?9,"CHNGDTT:",CHNGDTT
+27 IF $LENGTH(CHNGDTT)
DO SHOWDATE(CHNGDTT)
+28 WRITE !
+29 ;
+30 ; DataName Date/Time
SET DNDTT=$SELECT($LENGTH(CHNGDTT):CHNGDTT,1:OBSDTT)
+31 WRITE ?9,"DNDTT:",DNDTT
+32 IF $LENGTH(DNDTT)
DO SHOWDATE(DNDTT)
+33 WRITE !
+34 ;
+35 ; Result Copies To
SET RCTOSTR=$PIECE(STR,"|",29)
+36 IF $LENGTH(RCTOSTR)
Begin DoDot:1
+37 SET SUBSTR2=$TRANSLATE($PIECE(RCTOSTR,"^",2,6),"^"," ")
+38 ; If only spaces, skip
IF $LENGTH($TRANSLATE(SUBSTR2," "))<1
QUIT
+39 ;
+40 WRITE ?9,"RCTOSTR:",RCTOSTR,!,?14,"SUBSTR2:",SUBSTR2,!
+41 ;
+42 ; Assumption is that the NAME is in $P(SUBSTR," ",1,3)
+43 SET SUBSTR2=$PIECE(SUBSTR2," ")_","_$PIECE(SUBSTR2," ",2,$LENGTH(SUBSTR2," "))
+44 WRITE ?19,"SUBSTR2:",SUBSTR2,!
End DoDot:1
+45 ;
+46 QUIT
+47 ;
SHOWSEG ; EP - Show segment and setup STR variable
+1 WRITE ?4,SEG,!,?9,"FOUNDIT:",FOUNDIT,?39,"SEGIEN:",SEGIEN,!
+2 SET STR=$GET(^INTHU(FOUNDIT,3,SEGIEN,0))
+3 QUIT
+4 ;
SHOWDATE(HL7DT) ; EP - Take HL7 Date and display FM & External Date
+1 NEW FMDT
+2 ;
+3 SET TAB=$GET(TAB,9)
+4 SET FMDT=$$HL7TFM^XLFDT(HL7DT)
+5 WRITE ?39,FMDT
+6 WRITE ?59,$$FMTE^XLFDT(FMDT,"5MZ")
+7 QUIT
+8 ;
DISPOBX ; EP
+1 NEW ANSDTT,DATANAME,F60IEN,OBRIEN,STATUS,STR,TESTNAME,TSTLOINC
+2 ;
+3 DO SHOWSEG
+4 ;
+5 SET TSTLOINC=$PIECE($PIECE(STR,"|",4),"^")
+6 SET TESTNAME=$PIECE($PIECE(STR,"|",4),"^",2)
+7 SET ORIGTEXT=$PIECE($PIECE(STR,"|",4),"^",9)
+8 ;
+9 WRITE ?9,"TSTLOINC:",TSTLOINC,?39,"TESTNAME:"
+10 IF $LENGTH(TESTNAME)<31
WRITE TESTNAME,!
+11 IF $LENGTH(TESTNAME)>30
DO LINEWRAP^BLRGMENU(49,TESTNAME,30)
WRITE !
+12 WRITE ?9,"ORIGTEXT:",ORIGTEXT,!
+13 ;
+14 SET F60IEN=$$FIND1^DIC(60,,,ORIGTEXT_",")
+15 WRITE ?9,"F60IEN:",F60IEN,!
+16 ;
+17 SET DATANAME=$$GET1^DIQ(60,+F60IEN,400,"I")
+18 WRITE ?9,"DATANAME:",DATANAME,!
+19 ;
+20 ; Analysis Date/Time
SET ANSDTT=$PIECE($PIECE(STR,"|",15),"^")
+21 WRITE ?9,"ANSDTT:",ANSDTT
+22 IF $LENGTH(ANSDTT)
DO SHOWDATE(ANSDTT)
+23 WRITE !
+24 ;
+25 SET STATUS=$PIECE(STR,"|",12)
+26 WRITE ?9,"STATUS:",STATUS,!
+27 ;
+28 QUIT
+29 ;
DISPORC ; EP - Don't process anything in the PID Segment
+1 NEW STR
+2 DO SHOWSEG
+3 QUIT
+4 ;
DISPSPM ; EP
+1 NEW CONDSPEC,SPMIEN,STR
+2 ;
+3 DO SHOWSEG
+4 ;
+5 ; SPECIMEN CONDITION
SET CONDSPEC=$PIECE($PIECE(STR,"|",25),"^")
+6 WRITE ?9,"CONDSPEC:",CONDSPEC,!
+7 ;
+8 ; REJECTION REASON
SET REJREASN=$PIECE($PIECE(STR,"|",22),"^",2)
+9 WRITE ?9,"REJREASN:",REJREASN,!
+10 QUIT
+11 ;
DISPNTE ; EP - Don't process anything in the NTE Segment
+1 NEW STR
+2 DO SHOWSEG
+3 QUIT
+4 ;
DISPTQ1 ; EP - Don't process anything in the TQ1 Segment
+1 NEW STR
+2 DO SHOWSEG
+3 QUIT
