LR140P ; IHS/DIR/AAB - TEST REVIEWER 060697 0800 ;
;;5.2;LR;**1002**;JUN 01, 1998
;;5.2;LAB SERVICE;**140,171**;Sep 27, 1994
;Environment check is done only during the install.
;
INIT ;
K ^TMP("LRBIGD")
K DIR
;
CONTROL ;
W !!,"I'M EXAMINING YOUR DATA NAMES"
D LOOK
W @IOF
W !!,"Now, lets print a list of the BIG'ns.",!!
D DEVICE
DONE ;
;K ^TMP("LRBIGD")
K LRQ,LRIEN,LRCNT,OK,LRNODE
Q
LOOK ;
;
S LRCNT=0
S LRQ="^DD(63.04,0)"
F S LRQ=$Q(@LRQ) Q:LRQ'["DD(63.04" I @LRQ["K:$L(X)>" D
. I +$P(@LRQ,"K:$L(X)>",2)>50 S ^TMP("LRBIGD",LRQ)=@LRQ D
.. S LRCNT=LRCNT+1
. I IOST["C-" W "::"
;
Q
ADVICE ;
;
;
D LRGLIN^LRX
W ?8,"Review the test set-up of the OFFENDING test(s) and consider"
W !,?8,"one or more of the following recommendations:"
W !,?5,"1. Reduce the length of the test name."
W !,?5,"2. Reduce the length of the test result through the"
W !,?5," [Modify an existing data name] option."
W !,?5,"3. If the result is lengthy free text consider replacing the"
W !,?5," old CH subscript test with a new test in a different"
W !,?5," subscript area,...to SP for example.",!
D LRGLIN^LRX
Q
DEVICE ;
S OK=1
S %ZIS="Q"
QUE ;
S ZTSAVE("LR*")=""
S ZTRTN="DQ1^LR140P"
S ZTDESC="Lab Patch 140 ^LR report"
S ZTSAVE("^TMP(""LRBIGD""")=""
D IO^LRWU
QUIT
DQ1 ;
PRINT ;
S LRPAGE=1
S OK=1
U IO
D HEAD
S LRIEN=""
U IO
F S LRIEN=$O(^TMP("LRBIGD",LRIEN)) Q:LRIEN="" S LRNODE=^(LRIEN) D
. D CHKPG
. W !,LRIEN,"=",LRNODE,!
QUIT
HEAD ;
W @IOF
W $$RJ^XLFSTR("Page "_LRPAGE,IOM),!
W $$CJ^XLFSTR("List of Data Names greater than 50 characters.",IOM),!
D ADVICE
QUIT
CHKPG ;
Q:'OK
I IOSL-$Y'>3&($E(IOST,1,2)="C-") S DIR(0)="E" D ^DIR K DIR D
. W @IOF
. I $D(DTOUT)!($D(DUOUT)) S OK=0
Q:'OK
I IOSL-$Y'>3&($E(IOST,1,2)="P-") S LRPAGE=LRPAGE+1 D HEAD
;
QUIT
Q
LR140P ; IHS/DIR/AAB - TEST REVIEWER 060697 0800 ;
+1 ;;5.2;LR;**1002**;JUN 01, 1998
+2 ;;5.2;LAB SERVICE;**140,171**;Sep 27, 1994
+3 ;Environment check is done only during the install.
+4 ;
INIT ;
+1 KILL ^TMP("LRBIGD")
+2 KILL DIR
+3 ;
CONTROL ;
+1 WRITE !!,"I'M EXAMINING YOUR DATA NAMES"
+2 DO LOOK
+3 WRITE @IOF
+4 WRITE !!,"Now, lets print a list of the BIG'ns.",!!
+5 DO DEVICE
DONE ;
+1 ;K ^TMP("LRBIGD")
+2 KILL LRQ,LRIEN,LRCNT,OK,LRNODE
+3 QUIT
LOOK ;
+1 ;
+2 SET LRCNT=0
+3 SET LRQ="^DD(63.04,0)"
+4 FOR
SET LRQ=$QUERY(@LRQ)
IF LRQ'["DD(63.04"
QUIT
IF @LRQ["K:$L(X)>"
Begin DoDot:1
+5 IF +$PIECE(@LRQ,"K:$L(X)>",2)>50
SET ^TMP("LRBIGD",LRQ)=@LRQ
Begin DoDot:2
+6 SET LRCNT=LRCNT+1
End DoDot:2
+7 IF IOST["C-"
WRITE "::"
End DoDot:1
+8 ;
+9 QUIT
ADVICE ;
+1 ;
+2 ;
+3 DO LRGLIN^LRX
+4 WRITE ?8,"Review the test set-up of the OFFENDING test(s) and consider"
+5 WRITE !,?8,"one or more of the following recommendations:"
+6 WRITE !,?5,"1. Reduce the length of the test name."
+7 WRITE !,?5,"2. Reduce the length of the test result through the"
+8 WRITE !,?5," [Modify an existing data name] option."
+9 WRITE !,?5,"3. If the result is lengthy free text consider replacing the"
+10 WRITE !,?5," old CH subscript test with a new test in a different"
+11 WRITE !,?5," subscript area,...to SP for example.",!
+12 DO LRGLIN^LRX
+13 QUIT
DEVICE ;
+1 SET OK=1
+2 SET %ZIS="Q"
QUE ;
+1 SET ZTSAVE("LR*")=""
+2 SET ZTRTN="DQ1^LR140P"
+3 SET ZTDESC="Lab Patch 140 ^LR report"
+4 SET ZTSAVE("^TMP(""LRBIGD""")=""
+5 DO IO^LRWU
+6 QUIT
DQ1 ;
PRINT ;
+1 SET LRPAGE=1
+2 SET OK=1
+3 USE IO
+4 DO HEAD
+5 SET LRIEN=""
+6 USE IO
+7 FOR
SET LRIEN=$ORDER(^TMP("LRBIGD",LRIEN))
IF LRIEN=""
QUIT
SET LRNODE=^(LRIEN)
Begin DoDot:1
+8 DO CHKPG
+9 WRITE !,LRIEN,"=",LRNODE,!
End DoDot:1
+10 QUIT
HEAD ;
+1 WRITE @IOF
+2 WRITE $$RJ^XLFSTR("Page "_LRPAGE,IOM),!
+3 WRITE $$CJ^XLFSTR("List of Data Names greater than 50 characters.",IOM),!
+4 DO ADVICE
+5 QUIT
CHKPG ;
+1 IF 'OK
QUIT
+2 IF IOSL-$Y'>3&($EXTRACT(IOST,1,2)="C-")
SET DIR(0)="E"
DO ^DIR
KILL DIR
Begin DoDot:1
+3 WRITE @IOF
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
SET OK=0
End DoDot:1
+5 IF 'OK
QUIT
+6 IF IOSL-$Y'>3&($EXTRACT(IOST,1,2)="P-")
SET LRPAGE=LRPAGE+1
DO HEAD
+7 ;
+8 QUIT
+9 QUIT
