LRACS3 ;SLC/DCM - MISCELLANEOUS TESTS FOR SUPERVISORS SUMMARY ; 6/11/87 13:38 ; [ 04/11/2003 7:53 AM ]
;;5.2T9;LR;**1006,1008,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
ENT D HEAD S LRXLR="LRAC",LRHEAD2=0,LRLLOC="",LRSORT=$S($D(^LAB(64.5,1,4)):$P(^(4),U,1),1:""),LRMIC="" I '$D(^TMP($J,LRDT,"NOKILL")) K ^TMP($J) S ^TMP($J,LRDT,"NOKILL")="" D LRLLOC
D:LRSORT SORT^LRACS2 D EQUALS^LRX W @IOF D END Q
LRLLOC F I=0:0 S LRLLOC=$O(^LRO(69,LRDT,1,"AR",LRLLOC)) Q:LRLLOC="" S LRNM="" D:$Y>(IOSL-10) HEAD D HEAD1,LRNM
Q
LRNM F J=0:0 S LRNM=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM)) Q:LRNM="" D LRDFN
Q
LRDFN S LRDFN=0 F S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN)) Q:LRDFN<1!('$D(^LAC(LRXLR,+$G(LRDFN)))) S LRHEAD2=0 S:LRSORT ^TMP($J,LRNM,LRDFN)="" D:'LRSORT LRIDT
Q
LRIDT S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3) D PT^LRX
Q:'$D(^LAC(LRXLR,LRDFN,"MISC",1,0)) S Z=^LAC(LRXLR,LRDFN,0)
S LRIDT=0 F S LRIDT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT)) Q:LRIDT<1 S Z=^(LRIDT,0) D LRIFN
Q
LRIFN S LRVIDT=$P(Z,U,2),LRVDT=$P(Z,U,3) Q:LRVDT>(LRDT_.9999)!(LRVDT<LRLDT) S LRLOG=$P(Z,U,4),LRSPM=$P(Z,U,5),LRSPM=$S($L(LRSPM):$E($P(^LAB(61,LRSPM,0),U,1),1,7),1:LRSPM)
I LRHEAD2=0 D LRHEAD2 S LRHEAD2=1
S LRCL=2,Y=LRVIDT S Y=$$Y2K^LRX(Y) D:$Y>(IOSL-10) HEAD,HEAD1,LRHEAD2 W !,Y,?18,LRLOG," ",LRSPM," ",!?LRCL
S LRIFN=0 F S LRIFN=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,1,LRIFN)) Q:'LRIFN S Z=^(LRIFN,0),LRVAL=$P(Z,U,1),LRTST=$P(Z,U,3),X1=$P(Z,U,4),LRTST=$P(^LAB(60,LRTST,.1),U,1) D WRITE
I $D(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,"TX",0)) S K=0 F S K=$O(^LAC(LRXLR,LRDFN,"MISC",1,LRIDT,"TX",K)) Q:'K W !?2,^(K,0)
W ! Q
WRITE ;;W:$X>(IOM-19) !?LRCL S LRCL=LRCL+19 W " ",$J(LRTST,7),": ",LRVAL," ",?LRCL S LRCL=$S(LRCL>(IOM-19):2,1:LRCL) ;;**Horizontal mess**
W ?15,$J(LRTST,7),": ",LRVAL,! ;;**Vertical**
Q
HEAD D EQUALS^LRX W @IOF,!!,"SUPERVISOR'S SUMMARY REPORT ... MISCELLANEOUS TESTS"
Q
HEAD1 Q:'LRSORT W !!?15,"*** "_LRLLOC_" ***"
Q
LRHEAD2 ;D DASH^LRX W !!,PNM," ",?25,SSN_" ",?40,AGE,!
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
D DASH^LRX W !!,PNM," ",?25,HRCN_" ",?40,DOB,! ;IHS/ANMC/CLS 11/1/95
;----- EN DIHS MODIFICATIONS
Q
END ;K LRAG,LRCL,LRDFN,LRDT,LRHEAD2,LRIDT,LRIFN,LRIL,LRLDT,LRLLOC,LRLOG,LRMIC,LRMISC,LRNAME,LRNM,LRPG,LRPNM,LRSORT,LRSPM,LRTST,LRVAL,LRVDT,LRVIDT,LRXLR,LRYESCOM,SSN,X1,Y,Z,ZTRTN
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
K LRAG,LRCL,LRDFN,LRDT,LRHEAD2,LRIDT,LRIFN,LRIL,LRLDT,LRLLOC,LRLOG,LRMIC,LRMISC,LRNAME,LRNM,LRPG,LRPNM,LRSORT,LRSPM,LRTST,LRVAL,LRVDT,LRVIDT,LRXLR,LRYESCOM,SSN,HRCN,X1,Y,Z,ZTRTN ;IHS/ANMC/CLS 11/1/95 HRCN
;----- END IHS MODIFICATIONS
Q
LRACS3 ;SLC/DCM - MISCELLANEOUS TESTS FOR SUPERVISORS SUMMARY ; 6/11/87 13:38 ; [ 04/11/2003 7:53 AM ]
+1 ;;5.2T9;LR;**1006,1008,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
ENT DO HEAD
SET LRXLR="LRAC"
SET LRHEAD2=0
SET LRLLOC=""
SET LRSORT=$SELECT($DATA(^LAB(64.5,1,4)):$PIECE(^(4),U,1),1:"")
SET LRMIC=""
IF '$DATA(^TMP($JOB,LRDT,"NOKILL"))
KILL ^TMP($JOB)
SET ^TMP($JOB,LRDT,"NOKILL")=""
DO LRLLOC
+1 IF LRSORT
DO SORT^LRACS2
DO EQUALS^LRX
WRITE @IOF
DO END
QUIT
LRLLOC FOR I=0:0
SET LRLLOC=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC))
IF LRLLOC=""
QUIT
SET LRNM=""
IF $Y>(IOSL-10)
DO HEAD
DO HEAD1
DO LRNM
+1 QUIT
LRNM FOR J=0:0
SET LRNM=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM))
IF LRNM=""
QUIT
DO LRDFN
+1 QUIT
LRDFN SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN))
IF LRDFN<1!('$DATA(^LAC(LRXLR,+$GET(LRDFN))))
QUIT
SET LRHEAD2=0
IF LRSORT
SET ^TMP($JOB,LRNM,LRDFN)=""
IF 'LRSORT
DO LRIDT
+1 QUIT
LRIDT SET LRDPF=$PIECE(^LR(LRDFN,0),"^",2)
SET DFN=$PIECE(^(0),"^",3)
DO PT^LRX
+1 IF '$DATA(^LAC(LRXLR,LRDFN,"MISC",1,0))
QUIT
SET Z=^LAC(LRXLR,LRDFN,0)
+2 SET LRIDT=0
FOR
SET LRIDT=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT))
IF LRIDT<1
QUIT
SET Z=^(LRIDT,0)
DO LRIFN
+3 QUIT
LRIFN SET LRVIDT=$PIECE(Z,U,2)
SET LRVDT=$PIECE(Z,U,3)
IF LRVDT>(LRDT_.9999)!(LRVDT<LRLDT)
QUIT
SET LRLOG=$PIECE(Z,U,4)
SET LRSPM=$PIECE(Z,U,5)
SET LRSPM=$SELECT($LENGTH(LRSPM):$EXTRACT($PIECE(^LAB(61,LRSPM,0),U,1),1,7),1:LRSPM)
+1 IF LRHEAD2=0
DO LRHEAD2
SET LRHEAD2=1
+2 SET LRCL=2
SET Y=LRVIDT
SET Y=$$Y2K^LRX(Y)
IF $Y>(IOSL-10)
DO HEAD
DO HEAD1
DO LRHEAD2
WRITE !,Y,?18,LRLOG," ",LRSPM," ",!?LRCL
+3 SET LRIFN=0
FOR
SET LRIFN=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,1,LRIFN))
IF 'LRIFN
QUIT
SET Z=^(LRIFN,0)
SET LRVAL=$PIECE(Z,U,1)
SET LRTST=$PIECE(Z,U,3)
SET X1=$PIECE(Z,U,4)
SET LRTST=$PIECE(^LAB(60,LRTST,.1),U,1)
DO WRITE
+4 IF $DATA(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,"TX",0))
SET K=0
FOR
SET K=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,LRIDT,"TX",K))
IF 'K
QUIT
WRITE !?2,^(K,0)
+5 WRITE !
QUIT
WRITE ;;W:$X>(IOM-19) !?LRCL S LRCL=LRCL+19 W " ",$J(LRTST,7),": ",LRVAL," ",?LRCL S LRCL=$S(LRCL>(IOM-19):2,1:LRCL) ;;**Horizontal mess**
+1 ;;**Vertical**
WRITE ?15,$JUSTIFY(LRTST,7),": ",LRVAL,!
+2 QUIT
HEAD DO EQUALS^LRX
WRITE @IOF,!!,"SUPERVISOR'S SUMMARY REPORT ... MISCELLANEOUS TESTS"
+1 QUIT
HEAD1 IF 'LRSORT
QUIT
WRITE !!?15,"*** "_LRLLOC_" ***"
+1 QUIT
LRHEAD2 ;D DASH^LRX W !!,PNM," ",?25,SSN_" ",?40,AGE,!
+1 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+2 ;IHS/ANMC/CLS 11/1/95
DO DASH^LRX
WRITE !!,PNM," ",?25,HRCN_" ",?40,DOB,!
+3 ;----- EN DIHS MODIFICATIONS
+4 QUIT
END ;K LRAG,LRCL,LRDFN,LRDT,LRHEAD2,LRIDT,LRIFN,LRIL,LRLDT,LRLLOC,LRLOG,LRMIC,LRMISC,LRNAME,LRNM,LRPG,LRPNM,LRSORT,LRSPM,LRTST,LRVAL,LRVDT,LRVIDT,LRXLR,LRYESCOM,SSN,X1,Y,Z,ZTRTN
+1 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+2 ;IHS/ANMC/CLS 11/1/95 HRCN
KILL LRAG,LRCL,LRDFN,LRDT,LRHEAD2,LRIDT,LRIFN,LRIL,LRLDT,LRLLOC,LRLOG,LRMIC,LRMISC,LRNAME,LRNM,LRPG,LRPNM,LRSORT,LRSPM,LRTST,LRVAL,LRVDT,LRVIDT,LRXLR,LRYESCOM,SSN,HRCN,X1,Y,Z,ZTRTN
+3 ;----- END IHS MODIFICATIONS
+4 QUIT
