BLRMIRP2 ; IHS/MSC/MKK - IHS Lab Micro Report, part 2; 14-Apr-2014 11:50 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
PRELIM ; EP - Print any preliminary data
NEW CNT,COMMENT,NODE,PRELIM,STR
;
D PRELNODE(.NODE)
;
S (CNT,PRELIM)=0
F PRELIM=$O(NODE(PRELIM)) Q:PRELIM<1 D
. Q:$D(^LR(LRDFN,"MI",LRIDT,PRELIM))<1
. ;
. W ?4,$G(NODE(PRELIM)),!
. S LINES=1+$G(LINES)
. S COMMENT=0
. F S COMMENT=$O(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT)) Q:COMMENT<1 D
.. S STR=$G(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT,0))
.. D LINEWRAP^BLRGMENU(9,STR,71)
.. W !
.. S LINES=1+$G(LINES)
.. S CNT=CNT+1
;
W:CNT !
Q
;
PRELNODE(NODE) ; EP - Create NODE array to hold Preliminary "locations" from Lab Data file
NEW STR,WOT,WOT2
;
K NODE
S WOT=63.049999
F S WOT=$O(^DD(WOT)) Q:WOT<1!($E(WOT,1,5)'=63.05) D
. S WOT2=.9999999
. F S WOT2=$O(^DD(WOT,WOT2)) Q:WOT2<1 D
.. S STR=$G(^DD(WOT,WOT2,0))
.. S:$P(STR,"^")["PRELIMINARY" NODE($P($P(STR,"^",4),";"))=$P(STR,"^")
Q
;
EHRPLIM ; EP - EHR: any preliminary data
NEW CNT,COMMENT,NODE,PRELIM,STR,TABIT,TABIT2
;
S TABIT=$J("",5),TABIT2=$J("",10)
;
D PRELNODE(.NODE)
;
S (CNT,PRELIM)=0
F PRELIM=$O(NODE(PRELIM)) Q:PRELIM<1 D
. Q:$D(^LR(LRDFN,"MI",LRIDT,PRELIM))<1
. ;
. D ADDLINE^BLRMIEHR(TABIT_$G(NODE(PRELIM))_":")
. S COMMENT=0
. F S COMMENT=$O(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT)) Q:COMMENT<1 D
.. S STR=$G(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT,0))
.. D ADDLINE^BLRMIEHR(TABIT2_STR)
.. S CNT=CNT+1
;
D:CNT BLNKLINE^BLRMIEHR
Q
BLRMIRP2 ; IHS/MSC/MKK - IHS Lab Micro Report, part 2; 14-Apr-2014 11:50 ; MKK
+1 ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PRELIM ; EP - Print any preliminary data
+1 NEW CNT,COMMENT,NODE,PRELIM,STR
+2 ;
+3 DO PRELNODE(.NODE)
+4 ;
+5 SET (CNT,PRELIM)=0
+6 FOR PRELIM=$ORDER(NODE(PRELIM))
IF PRELIM<1
QUIT
Begin DoDot:1
+7 IF $DATA(^LR(LRDFN,"MI",LRIDT,PRELIM))<1
QUIT
+8 ;
+9 WRITE ?4,$GET(NODE(PRELIM)),!
+10 SET LINES=1+$GET(LINES)
+11 SET COMMENT=0
+12 FOR
SET COMMENT=$ORDER(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT))
IF COMMENT<1
QUIT
Begin DoDot:2
+13 SET STR=$GET(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT,0))
+14 DO LINEWRAP^BLRGMENU(9,STR,71)
+15 WRITE !
+16 SET LINES=1+$GET(LINES)
+17 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+18 ;
+19 IF CNT
WRITE !
+20 QUIT
+21 ;
PRELNODE(NODE) ; EP - Create NODE array to hold Preliminary "locations" from Lab Data file
+1 NEW STR,WOT,WOT2
+2 ;
+3 KILL NODE
+4 SET WOT=63.049999
+5 FOR
SET WOT=$ORDER(^DD(WOT))
IF WOT<1!($EXTRACT(WOT,1,5)'=63.05)
QUIT
Begin DoDot:1
+6 SET WOT2=.9999999
+7 FOR
SET WOT2=$ORDER(^DD(WOT,WOT2))
IF WOT2<1
QUIT
Begin DoDot:2
+8 SET STR=$GET(^DD(WOT,WOT2,0))
+9 IF $PIECE(STR,"^")["PRELIMINARY"
SET NODE($PIECE($PIECE(STR,"^",4),";"))=$PIECE(STR,"^")
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
EHRPLIM ; EP - EHR: any preliminary data
+1 NEW CNT,COMMENT,NODE,PRELIM,STR,TABIT,TABIT2
+2 ;
+3 SET TABIT=$JUSTIFY("",5)
SET TABIT2=$JUSTIFY("",10)
+4 ;
+5 DO PRELNODE(.NODE)
+6 ;
+7 SET (CNT,PRELIM)=0
+8 FOR PRELIM=$ORDER(NODE(PRELIM))
IF PRELIM<1
QUIT
Begin DoDot:1
+9 IF $DATA(^LR(LRDFN,"MI",LRIDT,PRELIM))<1
QUIT
+10 ;
+11 DO ADDLINE^BLRMIEHR(TABIT_$GET(NODE(PRELIM))_":")
+12 SET COMMENT=0
+13 FOR
SET COMMENT=$ORDER(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT))
IF COMMENT<1
QUIT
Begin DoDot:2
+14 SET STR=$GET(^LR(LRDFN,"MI",LRIDT,PRELIM,COMMENT,0))
+15 DO ADDLINE^BLRMIEHR(TABIT2_STR)
+16 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+17 ;
+18 IF CNT
DO BLNKLINE^BLRMIEHR
+19 QUIT
