LRACS2 ;SLC/DCM - LAB SUMMARY REPORT CONT. (MISC.) ; 2/22/87 3:08 PM ; [ 04/24/2003 7:11 AM ]
;;5.2T9;LR;**1006,1008,1018**;Nov 17, 2004
;;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
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
W !,PNM,?20,HRCN,?33,"DOB: ",DOB,?50,LRLLOC ;IHS/ANMC/CLS 11/1/95
;----- END IHS MODIFICATIONS
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
LRACS2 ;SLC/DCM - LAB SUMMARY REPORT CONT. (MISC.) ; 2/22/87 3:08 PM ; [ 04/24/2003 7:11 AM ]
+1 ;;5.2T9;LR;**1006,1008,1018**;Nov 17, 2004
+2 ;;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 ;W !,PNM,?20,SSN,?33,"AGE: ",AGE,?50,LRLLOC
+3 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+4 ;IHS/ANMC/CLS 11/1/95
WRITE !,PNM,?20,HRCN,?33,"DOB: ",DOB,?50,LRLLOC
+5 ;----- END IHS MODIFICATIONS
+6 SET LRAG=0
+7 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
