- LRACS2 ;SLC/DCM - LAB SUMMARY REPORT CONT. (MISC.) ; 2/22/87 3:08 PM ;
- ;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
- LRUDT S LRTIM=$E(LRFDT,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
- S LRUDT=$$Y2K^LRX($P(LRFDT,"."))_$J(LRTIM,5)
- Q
- HEAD D BOT,TOP Q
- BOT ;
- Y I $Y'>(IOSL-6) W ! G Y
- S LRPG=LRPG+1 Q
- TOP ;from LRACS1
- TOPLN ;from LRACS1
- D DASH^LRX S Z=^LAC(LRXLR,LRDFN,0)
- W !,PNM,?20,SSN,?33,"AGE: ",AGE,?50,LRLLOC
- S LRAG=0
- Q
- LRMISC S LRFDT=0,LRPG=1 D TOP
- MHI S LRMHN=$P(^LAC(LRXLR,LRDFN,LRMH,1,0),U,1) D WR
- MDT S LRFDT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT)) G:LRFDT<1 END S LRVDT=$P(^(LRFDT,0),U,3) G:$P(LRVDT,".",1)'=LRDT MDT D LRUDT S LRMIT=0
- LRMIT S LRMIT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT)) G:'LRMIT TXT S Z=^(LRMIT,0)
- S LRLO="",LRHI="",LRVAL=$P(Z,U,1),LRSPE=$P(Z,U,2),LRTEST=$P(Z,U,3),LRSPEM=$P(^LAB(61,LRSPE,0),U,1)
- G:'LRTEST COMM S LRUNT="",LRNAME=$P(^LAB(60,LRTEST,.1),U,1) S:$D(^LAB(60,LRTEST,1,LRSPE,0)) @("LRLO="_$S($L($P(^(0),U,2)):$P(^(0),U,2),1:"""""")),@("LRHI="_$S($L($P(^(0),U,3)):$P(^(0),U,3),1:"""""")),LRUNT=$P(^(0),U,7)
- WR1 D:$Y>(IOSL-12) WR W !!,LRUDT,?15,LRSPEM,?36,LRNAME,":",?50,LRVAL," ",LRUNT,?63 W:$L(LRLO) "NORMALS: ",LRLO,"-",LRHI
- G LRMIT
- COMM W !,"COMMENT: ",LRVAL G LRMIT
- WR D:$Y>(IOSL-12) HEAD S LRCL=21-$L(LRMHN)
- Q
- TXT S I=0 F S I=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,"TX",0)) Q:'I W !,^(I,0)
- G MDT
- END D BOT S LRLO="" K LRSB,LRMISC Q
- PRE Q:$O(^LAC(LRXLR,LRDFN,"MISC",1,0))'>0 S LRMISC=1,LRPG=$S($D(^LR(LRDFN,"PG",LRMH)):$P(^(LRMH),U,2),1:0),LRMH="MISC" G LRMISC
- Q
- SORT ;from LRACS, LRACS3
- S LRNM=""
- F S LRNM=$O(^TMP($J,LRNM)) Q:LRNM="" S LRDFN=0 F S LRDFN=$O(^TMP($J,LRNM,LRDFN)) Q:LRDFN<1 S LRLLOC=^(LRDFN) Q:$D(^LR(LRDFN,0))[0 S LRIL=0,LRNAME=0,LRPG=1,LRAG=0,LRYESCOM=0 D:$D(LRMIC) LRIDT^LRACS3 D:'$D(LRMIC) LRMH^LRACS1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACS2 1824 printed Jan 18, 2025@03:07:16 Page 2
- LRACS2 ;SLC/DCM - LAB SUMMARY REPORT CONT. (MISC.) ; 2/22/87 3:08 PM ;
- +1 ;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
- LRUDT SET LRTIM=$EXTRACT(LRFDT,9,12)
- FOR I=0:0
- if $LENGTH(LRTIM)=4
- QUIT
- SET LRTIM=LRTIM_0
- +1 SET LRUDT=$$Y2K^LRX($PIECE(LRFDT,"."))_$JUSTIFY(LRTIM,5)
- +2 QUIT
- HEAD DO BOT
- DO TOP
- QUIT
- BOT ;
- Y IF $Y'>(IOSL-6)
- WRITE !
- GOTO Y
- +1 SET LRPG=LRPG+1
- QUIT
- TOP ;from LRACS1
- TOPLN ;from LRACS1
- +1 DO DASH^LRX
- SET Z=^LAC(LRXLR,LRDFN,0)
- +2 WRITE !,PNM,?20,SSN,?33,"AGE: ",AGE,?50,LRLLOC
- +3 SET LRAG=0
- +4 QUIT
- LRMISC SET LRFDT=0
- SET LRPG=1
- DO TOP
- MHI SET LRMHN=$PIECE(^LAC(LRXLR,LRDFN,LRMH,1,0),U,1)
- DO WR
- MDT SET LRFDT=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT))
- if LRFDT<1
- GOTO END
- SET LRVDT=$PIECE(^(LRFDT,0),U,3)
- if $PIECE(LRVDT,".",1)'=LRDT
- GOTO MDT
- DO LRUDT
- SET LRMIT=0
- LRMIT SET LRMIT=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT))
- if 'LRMIT
- GOTO TXT
- SET Z=^(LRMIT,0)
- +1 SET LRLO=""
- SET LRHI=""
- SET LRVAL=$PIECE(Z,U,1)
- SET LRSPE=$PIECE(Z,U,2)
- SET LRTEST=$PIECE(Z,U,3)
- SET LRSPEM=$PIECE(^LAB(61,LRSPE,0),U,1)
- +2 if 'LRTEST
- GOTO COMM
- SET LRUNT=""
- SET LRNAME=$PIECE(^LAB(60,LRTEST,.1),U,1)
- if $DATA(^LAB(60,LRTEST,1,LRSPE,0))
- SET @("LRLO="_$SELECT($LENGTH($PIECE(^(0),U,2)):$PIECE(^(0),U,2),1:""""""))
- SET @("LRHI="_$SELECT($LENGTH($PIECE(^(0),U,3)):$PIECE(^(0),U,3),1:""""""))
- SET LRUNT=$PIECE(^(0),U,7)
- WR1 if $Y>(IOSL-12)
- DO WR
- WRITE !!,LRUDT,?15,LRSPEM,?36,LRNAME,":",?50,LRVAL," ",LRUNT,?63
- if $LENGTH(LRLO)
- WRITE "NORMALS: ",LRLO,"-",LRHI
- +1 GOTO LRMIT
- COMM WRITE !,"COMMENT: ",LRVAL
- GOTO LRMIT
- WR if $Y>(IOSL-12)
- DO HEAD
- SET LRCL=21-$LENGTH(LRMHN)
- +1 QUIT
- TXT SET I=0
- FOR
- SET I=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,"TX",0))
- if 'I
- QUIT
- WRITE !,^(I,0)
- +1 GOTO MDT
- END DO BOT
- SET LRLO=""
- KILL LRSB,LRMISC
- QUIT
- PRE if $ORDER(^LAC(LRXLR,LRDFN,"MISC",1,0))'>0
- QUIT
- SET LRMISC=1
- SET LRPG=$SELECT($DATA(^LR(LRDFN,"PG",LRMH)):$PIECE(^(LRMH),U,2),1:0)
- SET LRMH="MISC"
- GOTO LRMISC
- +1 QUIT
- SORT ;from LRACS, LRACS3
- +1 SET LRNM=""
- +2 FOR
- SET LRNM=$ORDER(^TMP($JOB,LRNM))
- if LRNM=""
- QUIT
- SET LRDFN=0
- FOR
- SET LRDFN=$ORDER(^TMP($JOB,LRNM,LRDFN))
- if LRDFN<1
- QUIT
- SET LRLLOC=^(LRDFN)
- if $DATA(^LR(LRDFN,0))[0
- QUIT
- SET LRIL=0
- SET LRNAME=0
- SET LRPG=1
- SET LRAG=0
- SET LRYESCOM=0
- if $DATA(LRMIC)
- DO LRIDT^LRACS3
- if '$DATA(LRMIC)
- DO LRMH^LRACS1
- +3 QUIT