- 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
