- 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
