BLRLRPT ; IHS/OIT/MPW - LOINC Mapping to File 60 Tests ; [ JUN 29, 2010 ]
;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
;;This routine prints reports for tests in File 60 that are mapped or not mapped to LOINC.
;
; Temporary Globals
; -----------------
; ^XTMP("BLRLRPT","LOINC") - Holds mapped tests
; ^XTMP("BLRLRPT","NO LOINC") - Holds non-mapped tests
;
; Local Variables
; ---------------
; ACNT - Counter of all ACTIVE tests in File 60
; CCNT - Counter of tests mapped to C80 LOINC codes
; CNT - Counter of all tests (active and inactive) in File 60
; D0 - Test IEN from File 60
; D1 - Specimen IEN from File 60
; GCNT - Counter of C80 LOINC codes mapped to File 60
; ICNT - Counter of IHS(non-specimen) LOINC codes
; LCNT - Counter of specimen-specific LOINC codes
; LOINC - LOINC code
; NAME - Test name from File 60
; NCNT - Counter of tests w/o LOINC codes
; NSPEC - Counter of tests w/o specimens (includes cosmic)
; PCNT - Counter of cosmic tests w/o LOINC codes
; SCNT - Counter of all specimens in File 60
; SPNM - Specimen name from File 61, defaults to SPECXXX
; UNITS - Units from File 60, defaults to UNITXXX
; ZCNT - Counter of inactive tests in File 60, not mapped
;
;Must enter via proper tag/menu option
Q
;
PRNT ; Print File 60 tests mapped/not mapped to LOINC code
;
; Reset temporary globals
K ^XTMP("BLRLRPT")
;
; Initialize variables
N ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT
N HDR,HDR1,HDR2,HDR3,LOINC,NAME,NOW,Q,Q1,R,R1,SPNM,UDL,UNITS
D INIT
;
S HDR="Print Lab Tests Mapped/Not Mapped to LOINC Codes" D HDR
W !!,"1. Print Tests Mapped to LOINC"
W !,"2. Print Tests NOT Mapped to LOINC"
W !!,"Enter selection # or '^' to quit: " R R:30 Q:R="^"!(R="")
I "1 2"'[R W !!,"Invalid Entry" H 2 G PRNT
S OPT="OPT"_R D @OPT
;
K ACNT,CNT,CCNT,GCNT,HDR,HDR1,HDR2,HDR3,ICNT,LCNT,LOINC,NAME,NCNT,NSPEC,NOW,PCNT,Q,Q1,R,R1,SCNT,SPN,SPNM,UDL,UNITS,ZCNT
Q
;
OPT1 ; Print Lab Tests Mapped to LOINC Codes
;
;Gather data from File 60
F S D0=$O(^LAB(60,D0)) Q:Q1!(D0'=+D0) D
.S CNT=CNT+1,NAME=$P(^LAB(60,D0,0),U,1),TYP=$P(^LAB(60,D0,0),U,3)
.;Don't report inactive tests
.I $E(NAME,1,2)="ZZ"!($E(NAME,1,2)="zz") S ZCNT=ZCNT+1 Q
.S ACNT=ACNT+1
.I $O(^LAB(60,D0,1,0))="" S NSPEC=NSPEC+1 I $D(^LAB(60,D0,9999999)),$P(^LAB(60,D0,9999999),U,2)'="" D
..S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
..S ICNT=ICNT+1,LOINC=$P(^LAB(60,D0,9999999),U,2)
..S ^XTMP("BLRLRPT","LOINC","IHS",NAME)=LOINC_"-"_$P(^LAB(95.3,LOINC,0),U,15)
..Q
.I $O(^LAB(60,D0,1,0))'="" S D1=0 D
..F S D1=$O(^LAB(60,D0,1,D1)) Q:D1=""!(D1'=+D1) D
...S SCNT=SCNT+1,SPNM=$S($D(^LAB(61,D1,0)):$P(^LAB(61,D1,0),U,1),1:"SPECXXX")
...S UNITS=$P(^LAB(60,D0,1,D1,0),U,7) I UNITS="" S UNITS="UNITXXX"
...I $G(^LAB(60,D0,1,D1,95.3))'="" S LCNT=LCNT+1,LOINC=$G(^LAB(60,D0,1,D1,95.3)),^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)=LOINC_"-"_$P(^LAB(95.3,LOINC,0),U,15)
...Q
..Q
.Q
;
;Print results
S DIR(0)="Y",DIR("A")="Ready to capture output to a file",DIR("B")="Y"
D ^DIR K DIR
S R1=+Y
D ^XBCLS
S HDR="FILE 60 TESTS WITH LOINC CODES"
S HDR1=$G(NOW)
S HDR2="TEST NAME SPECIMEN UNITS LOINC"
S HDR3="================================================================================"
W !!,$$CJ^XLFSTR(HDR,IOM)
S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
W !!,HDR2,!,HDR3
S NAME=""
F S NAME=$O(^XTMP("BLRLRPT","LOINC",NAME)) Q:NAME=""!Q1 D
.I 'R1,$Y>20 D CR Q:Q1 W !,$$CJ^XLFSTR(HDR,IOM) S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
.I R1,$Y>56 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
.I $D(^XTMP("BLRLRPT","LOINC",NAME))=1 S LOINC=$G(^XTMP("BLRLRPT","LOINC",NAME)) W !,NAME,?70,LOINC,!,?2,$G(^LAB(95.3,LOINC,80)),! Q
.S SPNM="" F S SPNM=$O(^XTMP("BLRLRPT","LOINC",NAME,SPNM)) Q:SPNM="" D
..S UNITS="" F S UNITS=$O(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)) Q:UNITS="" D
...S LOINC=$G(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)),LNC=$P(LOINC,"-",1) W !,NAME,?32,$E(SPNM,1,12),?46,UNITS,?70,LOINC
...S REC=$O(^BLSLMAST("C",LNC,"")) Q:REC="" S SRC=$G(^BLSLMAST(REC,11)) Q:SRC="" I SRC="C80" W "*" S CCNT=CCNT+1 S:'$D(^XTMP("BLRLRPT","C80",LOINC)) GCNT=GCNT+1,^XTMP("BLRLRPT","C80",LOINC)=""
...W !,?2,$G(^LAB(95.3,LNC,80)),!
...Q
..Q
.Q
;Print any non-specimen LOINCed tests
I $D(^XTMP("BLRLRPT","LOINC","IHS"))&('Q1) D
.D ^XBCLS
.S HDR2="TEST NAME (CATAGORY) LOINC"
.S HDR3="================================================================================"
.W !!,$$CJ^XLFSTR(HDR,IOM)
.S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
.W !!,HDR2,!,HDR3
.S NAME="" F S NAME=$O(^XTMP("BLRLRPT","LOINC","IHS",NAME)) Q:NAME=""!(Q1) D
..S LOINC=$G(^XTMP("BLRLRPT","LOINC","IHS",NAME)),LNC=$P(LOINC,"-",1)
..I 'R1,$Y>20 D CR Q:Q1 W !,$$CJ^XLFSTR(HDR,IOM) S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
..I R1,$Y>56 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
..W !,NAME,?32,LOINC,!,?2,$G(^LAB(95.3,LNC,80)),!
..Q
.Q
;Print summary
W !!,$J(CNT,6)," Total Active/Inactive Tests in File 60"
W !,$J(ZCNT,6)," INACTIVE Tests (",$E(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
;
W !!,$J(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
W !,$J(NSPEC,6)," Active Tests w/o Specimens in File 60"
W !,$J(SCNT+NSPEC,6)," Total Entries to Map in File 60"
;
W !!,$J(LCNT,6)," Tests w/ Specimens (",$E(LCNT/SCNT*100,1,5),"%) Mapped"
W !,$J(ICNT,6)," Tests w/o Specimens (",$E(ICNT/NSPEC*100,1,5),"%) Mapped"
W !,$J(LCNT+ICNT,6)," Total Entries (",$E((LCNT+ICNT)/(SCNT+NSPEC)*100,1,5),"%) Mapped"
;
W !!,$J(CCNT,6)," Entries (",$E(CCNT/ACNT*100,1,5),"%) Mapped to C80 LOINC Codes"
W !,$J(GCNT,6)," C80 LOINC Codes (",$E(GCNT/290*100,1,5),"%) Mapped to File 60"
Q
;
OPT2 ; Print Lab Tests NOT Mapped to LOINC Codes
;
;Gather data from File 60
F S D0=$O(^LAB(60,D0)) Q:Q1!(D0'=+D0) D
.S CNT=CNT+1,NAME=$P(^LAB(60,D0,0),U,1),TYP=$P(^LAB(60,D0,0),U,3)
.;Don't report inactive tests
.I $E(NAME,1,2)="ZZ"!($E(NAME,1,2)="zz") S ZCNT=ZCNT+1 Q
.S ACNT=ACNT+1
.I $O(^LAB(60,D0,1,0))="" S NSPEC=NSPEC+1 D
..I '$D(^LAB(60,D0,9999999)) D
...S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
...S PCNT=PCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME)=""
...Q
..I $D(^LAB(60,D0,9999999)),$P(^LAB(60,D0,9999999),U,2)="" D
...S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
...S PCNT=PCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME)=""
...Q
..Q
.I $O(^LAB(60,D0,1,0))'="" S D1=0 D
..F S D1=$O(^LAB(60,D0,1,D1)) Q:D1=""!(D1'=+D1) D
...S SCNT=SCNT+1,SPNM=$S($D(^LAB(61,D1,0)):$P(^LAB(61,D1,0),U,1),1:"SPECXXX")
...S UNITS=$P(^LAB(60,D0,1,D1,0),U,7) I UNITS="" S UNITS="UNITXXX"
...I $G(^LAB(60,D0,1,D1,95.3))="" S NCNT=NCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,UNITS)=""
...Q
..Q
.Q
;
;Print results
S DIR(0)="Y",DIR("A")="Ready to capture output to a file",DIR("B")="Y"
D ^DIR K DIR
S R1=+Y
D ^XBCLS
S HDR="FILE 60 TESTS WITHOUT LOINC CODES"
S HDR1=$G(NOW)
S HDR2="TEST NAME (CATAGORY) SPECIMEN UNITS"
S HDR3="================================================================================"
W !!,$$CJ^XLFSTR(HDR,IOM)
S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
W !!,HDR2,!,HDR3
S NAME=""
F S NAME=$O(^XTMP("BLRLRPT","NO LOINC",NAME)) Q:NAME=""!Q1 D
.I 'R1,$Y>22 D CR Q:Q1 W !,$$CJ^XLFSTR(HDR,IOM) S PG=PG+1 W !,?5,HDR1,?70,"PAGE:",PG,!!,HDR2,!,HDR3
.I R1,$Y>57 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
.I $D(^XTMP("BLRLRPT","NO LOINC",NAME))=1 W !,NAME Q
.S SPNM="" F S SPNM=$O(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM)) Q:SPNM="" D
..S UNITS=$O(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,"")) W !,NAME,?46,$E(SPNM,1,12),?60,UNITS
..Q
.Q
;Print summary
W !!,$J(CNT,6)," Total Active/Inactive Tests in File 60"
W !,$J(ZCNT,6)," INACTIVE Tests (",$E(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
;
W !!,$J(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
W !,$J(NSPEC,6)," Active Tests w/o Specimens in File 60"
W !,$J(SCNT+NSPEC,6)," Total Entries to Map in File 60"
;
W !!,$J(NCNT,6)," Tests/Specimens (",$E(NCNT/SCNT*100,1,5),"%) NOT Mapped"
W !,$J(PCNT,6)," Tests w/o Specimens (",$E(PCNT/NSPEC*100,1,5),"%) NOT Mapped"
Q
;
;======================================================================================
;
INIT ; Initialize variables
D ^XBCLS
S CM=",",(D0,D1,D2,PG,Q,Q1,R1)=0
S (ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT)=0
S (HDR,HDR1,HDR2,HDR3,LOINC,NAME,R,SPNM,UDL,UNITS)=""
S NOW=$$HTE^XLFDT($H)
Q
;
HDR ; Print appropriate header
W !!,$$CJ^XLFSTR(HDR,IOM)
F I=1:1:$L(HDR) S UDL=UDL_"="
W !,$$CJ^XLFSTR(UDL,IOM)
Q
;
CR ; Prompt to continue or exit
;S DIR(0)="^",DIR("A")="Enter RETURN to continue or '^' to exit"
;D ^DIR K DIR
;I +Y S Q1=1 Q
;S $Y=0 Q
W !,"Enter RETURN to continue or '^' to exit: " R ANS:30
I ANS="^" S Q1=1 Q
I ANS="" S $Y=0 Q
D CR
Q
BLRLRPT ; IHS/OIT/MPW - LOINC Mapping to File 60 Tests ; [ JUN 29, 2010 ]
+1 ;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
+2 ;;This routine prints reports for tests in File 60 that are mapped or not mapped to LOINC.
+3 ;
+4 ; Temporary Globals
+5 ; -----------------
+6 ; ^XTMP("BLRLRPT","LOINC") - Holds mapped tests
+7 ; ^XTMP("BLRLRPT","NO LOINC") - Holds non-mapped tests
+8 ;
+9 ; Local Variables
+10 ; ---------------
+11 ; ACNT - Counter of all ACTIVE tests in File 60
+12 ; CCNT - Counter of tests mapped to C80 LOINC codes
+13 ; CNT - Counter of all tests (active and inactive) in File 60
+14 ; D0 - Test IEN from File 60
+15 ; D1 - Specimen IEN from File 60
+16 ; GCNT - Counter of C80 LOINC codes mapped to File 60
+17 ; ICNT - Counter of IHS(non-specimen) LOINC codes
+18 ; LCNT - Counter of specimen-specific LOINC codes
+19 ; LOINC - LOINC code
+20 ; NAME - Test name from File 60
+21 ; NCNT - Counter of tests w/o LOINC codes
+22 ; NSPEC - Counter of tests w/o specimens (includes cosmic)
+23 ; PCNT - Counter of cosmic tests w/o LOINC codes
+24 ; SCNT - Counter of all specimens in File 60
+25 ; SPNM - Specimen name from File 61, defaults to SPECXXX
+26 ; UNITS - Units from File 60, defaults to UNITXXX
+27 ; ZCNT - Counter of inactive tests in File 60, not mapped
+28 ;
+29 ;Must enter via proper tag/menu option
+30 QUIT
+31 ;
PRNT ; Print File 60 tests mapped/not mapped to LOINC code
+1 ;
+2 ; Reset temporary globals
+3 KILL ^XTMP("BLRLRPT")
+4 ;
+5 ; Initialize variables
+6 NEW ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT
+7 NEW HDR,HDR1,HDR2,HDR3,LOINC,NAME,NOW,Q,Q1,R,R1,SPNM,UDL,UNITS
+8 DO INIT
+9 ;
+10 SET HDR="Print Lab Tests Mapped/Not Mapped to LOINC Codes"
DO HDR
+11 WRITE !!,"1. Print Tests Mapped to LOINC"
+12 WRITE !,"2. Print Tests NOT Mapped to LOINC"
+13 WRITE !!,"Enter selection # or '^' to quit: "
READ R:30
IF R="^"!(R="")
QUIT
+14 IF "1 2"'[R
WRITE !!,"Invalid Entry"
HANG 2
GOTO PRNT
+15 SET OPT="OPT"_R
DO @OPT
+16 ;
+17 KILL ACNT,CNT,CCNT,GCNT,HDR,HDR1,HDR2,HDR3,ICNT,LCNT,LOINC,NAME,NCNT,NSPEC,NOW,PCNT,Q,Q1,R,R1,SCNT,SPN,SPNM,UDL,UNITS,ZCNT
+18 QUIT
+19 ;
OPT1 ; Print Lab Tests Mapped to LOINC Codes
+1 ;
+2 ;Gather data from File 60
+3 FOR
SET D0=$ORDER(^LAB(60,D0))
IF Q1!(D0'=+D0)
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
SET NAME=$PIECE(^LAB(60,D0,0),U,1)
SET TYP=$PIECE(^LAB(60,D0,0),U,3)
+5 ;Don't report inactive tests
+6 IF $EXTRACT(NAME,1,2)="ZZ"!($EXTRACT(NAME,1,2)="zz")
SET ZCNT=ZCNT+1
QUIT
+7 SET ACNT=ACNT+1
+8 IF $ORDER(^LAB(60,D0,1,0))=""
SET NSPEC=NSPEC+1
IF $DATA(^LAB(60,D0,9999999))
IF $PIECE(^LAB(60,D0,9999999),U,2)'=""
Begin DoDot:2
+9 SET NAME=$SELECT($ORDER(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$PIECE(^LAB(60,D0,0),U,4)_")")
+10 SET ICNT=ICNT+1
SET LOINC=$PIECE(^LAB(60,D0,9999999),U,2)
+11 SET ^XTMP("BLRLRPT","LOINC","IHS",NAME)=LOINC_"-"_$PIECE(^LAB(95.3,LOINC,0),U,15)
+12 QUIT
End DoDot:2
+13 IF $ORDER(^LAB(60,D0,1,0))'=""
SET D1=0
Begin DoDot:2
+14 FOR
SET D1=$ORDER(^LAB(60,D0,1,D1))
IF D1=""!(D1'=+D1)
QUIT
Begin DoDot:3
+15 SET SCNT=SCNT+1
SET SPNM=$SELECT($DATA(^LAB(61,D1,0)):$PIECE(^LAB(61,D1,0),U,1),1:"SPECXXX")
+16 SET UNITS=$PIECE(^LAB(60,D0,1,D1,0),U,7)
IF UNITS=""
SET UNITS="UNITXXX"
+17 IF $GET(^LAB(60,D0,1,D1,95.3))'=""
SET LCNT=LCNT+1
SET LOINC=$GET(^LAB(60,D0,1,D1,95.3))
SET ^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)=LOINC_"-"_$PIECE(^LAB(95.3,LOINC,0),U,15)
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 ;
+22 ;Print results
+23 SET DIR(0)="Y"
SET DIR("A")="Ready to capture output to a file"
SET DIR("B")="Y"
+24 DO ^DIR
KILL DIR
+25 SET R1=+Y
+26 DO ^XBCLS
+27 SET HDR="FILE 60 TESTS WITH LOINC CODES"
+28 SET HDR1=$GET(NOW)
+29 SET HDR2="TEST NAME SPECIMEN UNITS LOINC"
+30 SET HDR3="================================================================================"
+31 WRITE !!,$$CJ^XLFSTR(HDR,IOM)
+32 SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE: ",PG
+33 WRITE !!,HDR2,!,HDR3
+34 SET NAME=""
+35 FOR
SET NAME=$ORDER(^XTMP("BLRLRPT","LOINC",NAME))
IF NAME=""!Q1
QUIT
Begin DoDot:1
+36 IF 'R1
IF $Y>20
DO CR
IF Q1
QUIT
WRITE !,$$CJ^XLFSTR(HDR,IOM)
SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
+37 IF R1
IF $Y>56
SET $Y=0
SET PG=PG+1
WRITE !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
+38 IF $DATA(^XTMP("BLRLRPT","LOINC",NAME))=1
SET LOINC=$GET(^XTMP("BLRLRPT","LOINC",NAME))
WRITE !,NAME,?70,LOINC,!,?2,$GET(^LAB(95.3,LOINC,80)),!
QUIT
+39 SET SPNM=""
FOR
SET SPNM=$ORDER(^XTMP("BLRLRPT","LOINC",NAME,SPNM))
IF SPNM=""
QUIT
Begin DoDot:2
+40 SET UNITS=""
FOR
SET UNITS=$ORDER(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS))
IF UNITS=""
QUIT
Begin DoDot:3
+41 SET LOINC=$GET(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS))
SET LNC=$PIECE(LOINC,"-",1)
WRITE !,NAME,?32,$EXTRACT(SPNM,1,12),?46,UNITS,?70,LOINC
+42 SET REC=$ORDER(^BLSLMAST("C",LNC,""))
IF REC=""
QUIT
SET SRC=$GET(^BLSLMAST(REC,11))
IF SRC=""
QUIT
IF SRC="C80"
WRITE "*"
SET CCNT=CCNT+1
IF '$DATA(^XTMP("BLRLRPT","C80",LOINC))
SET GCNT=GCNT+1
SET ^XTMP("BLRLRPT","C80",LOINC)=""
+43 WRITE !,?2,$GET(^LAB(95.3,LNC,80)),!
+44 QUIT
End DoDot:3
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 ;Print any non-specimen LOINCed tests
+48 IF $DATA(^XTMP("BLRLRPT","LOINC","IHS"))&('Q1)
Begin DoDot:1
+49 DO ^XBCLS
+50 SET HDR2="TEST NAME (CATAGORY) LOINC"
+51 SET HDR3="================================================================================"
+52 WRITE !!,$$CJ^XLFSTR(HDR,IOM)
+53 SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE: ",PG
+54 WRITE !!,HDR2,!,HDR3
+55 SET NAME=""
FOR
SET NAME=$ORDER(^XTMP("BLRLRPT","LOINC","IHS",NAME))
IF NAME=""!(Q1)
QUIT
Begin DoDot:2
+56 SET LOINC=$GET(^XTMP("BLRLRPT","LOINC","IHS",NAME))
SET LNC=$PIECE(LOINC,"-",1)
+57 IF 'R1
IF $Y>20
DO CR
IF Q1
QUIT
WRITE !,$$CJ^XLFSTR(HDR,IOM)
SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
+58 IF R1
IF $Y>56
SET $Y=0
SET PG=PG+1
WRITE !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
+59 WRITE !,NAME,?32,LOINC,!,?2,$GET(^LAB(95.3,LNC,80)),!
+60 QUIT
End DoDot:2
+61 QUIT
End DoDot:1
+62 ;Print summary
+63 WRITE !!,$JUSTIFY(CNT,6)," Total Active/Inactive Tests in File 60"
+64 WRITE !,$JUSTIFY(ZCNT,6)," INACTIVE Tests (",$EXTRACT(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
+65 ;
+66 WRITE !!,$JUSTIFY(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
+67 WRITE !,$JUSTIFY(NSPEC,6)," Active Tests w/o Specimens in File 60"
+68 WRITE !,$JUSTIFY(SCNT+NSPEC,6)," Total Entries to Map in File 60"
+69 ;
+70 WRITE !!,$JUSTIFY(LCNT,6)," Tests w/ Specimens (",$EXTRACT(LCNT/SCNT*100,1,5),"%) Mapped"
+71 WRITE !,$JUSTIFY(ICNT,6)," Tests w/o Specimens (",$EXTRACT(ICNT/NSPEC*100,1,5),"%) Mapped"
+72 WRITE !,$JUSTIFY(LCNT+ICNT,6)," Total Entries (",$EXTRACT((LCNT+ICNT)/(SCNT+NSPEC)*100,1,5),"%) Mapped"
+73 ;
+74 WRITE !!,$JUSTIFY(CCNT,6)," Entries (",$EXTRACT(CCNT/ACNT*100,1,5),"%) Mapped to C80 LOINC Codes"
+75 WRITE !,$JUSTIFY(GCNT,6)," C80 LOINC Codes (",$EXTRACT(GCNT/290*100,1,5),"%) Mapped to File 60"
+76 QUIT
+77 ;
OPT2 ; Print Lab Tests NOT Mapped to LOINC Codes
+1 ;
+2 ;Gather data from File 60
+3 FOR
SET D0=$ORDER(^LAB(60,D0))
IF Q1!(D0'=+D0)
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
SET NAME=$PIECE(^LAB(60,D0,0),U,1)
SET TYP=$PIECE(^LAB(60,D0,0),U,3)
+5 ;Don't report inactive tests
+6 IF $EXTRACT(NAME,1,2)="ZZ"!($EXTRACT(NAME,1,2)="zz")
SET ZCNT=ZCNT+1
QUIT
+7 SET ACNT=ACNT+1
+8 IF $ORDER(^LAB(60,D0,1,0))=""
SET NSPEC=NSPEC+1
Begin DoDot:2
+9 IF '$DATA(^LAB(60,D0,9999999))
Begin DoDot:3
+10 SET NAME=$SELECT($ORDER(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$PIECE(^LAB(60,D0,0),U,4)_")")
+11 SET PCNT=PCNT+1
SET ^XTMP("BLRLRPT","NO LOINC",NAME)=""
+12 QUIT
End DoDot:3
+13 IF $DATA(^LAB(60,D0,9999999))
IF $PIECE(^LAB(60,D0,9999999),U,2)=""
Begin DoDot:3
+14 SET NAME=$SELECT($ORDER(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$PIECE(^LAB(60,D0,0),U,4)_")")
+15 SET PCNT=PCNT+1
SET ^XTMP("BLRLRPT","NO LOINC",NAME)=""
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 IF $ORDER(^LAB(60,D0,1,0))'=""
SET D1=0
Begin DoDot:2
+19 FOR
SET D1=$ORDER(^LAB(60,D0,1,D1))
IF D1=""!(D1'=+D1)
QUIT
Begin DoDot:3
+20 SET SCNT=SCNT+1
SET SPNM=$SELECT($DATA(^LAB(61,D1,0)):$PIECE(^LAB(61,D1,0),U,1),1:"SPECXXX")
+21 SET UNITS=$PIECE(^LAB(60,D0,1,D1,0),U,7)
IF UNITS=""
SET UNITS="UNITXXX"
+22 IF $GET(^LAB(60,D0,1,D1,95.3))=""
SET NCNT=NCNT+1
SET ^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,UNITS)=""
+23 QUIT
End DoDot:3
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 ;
+27 ;Print results
+28 SET DIR(0)="Y"
SET DIR("A")="Ready to capture output to a file"
SET DIR("B")="Y"
+29 DO ^DIR
KILL DIR
+30 SET R1=+Y
+31 DO ^XBCLS
+32 SET HDR="FILE 60 TESTS WITHOUT LOINC CODES"
+33 SET HDR1=$GET(NOW)
+34 SET HDR2="TEST NAME (CATAGORY) SPECIMEN UNITS"
+35 SET HDR3="================================================================================"
+36 WRITE !!,$$CJ^XLFSTR(HDR,IOM)
+37 SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE: ",PG
+38 WRITE !!,HDR2,!,HDR3
+39 SET NAME=""
+40 FOR
SET NAME=$ORDER(^XTMP("BLRLRPT","NO LOINC",NAME))
IF NAME=""!Q1
QUIT
Begin DoDot:1
+41 IF 'R1
IF $Y>22
DO CR
IF Q1
QUIT
WRITE !,$$CJ^XLFSTR(HDR,IOM)
SET PG=PG+1
WRITE !,?5,HDR1,?70,"PAGE:",PG,!!,HDR2,!,HDR3
+42 IF R1
IF $Y>57
SET $Y=0
SET PG=PG+1
WRITE !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
+43 IF $DATA(^XTMP("BLRLRPT","NO LOINC",NAME))=1
WRITE !,NAME
QUIT
+44 SET SPNM=""
FOR
SET SPNM=$ORDER(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM))
IF SPNM=""
QUIT
Begin DoDot:2
+45 SET UNITS=$ORDER(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,""))
WRITE !,NAME,?46,$EXTRACT(SPNM,1,12),?60,UNITS
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 ;Print summary
+49 WRITE !!,$JUSTIFY(CNT,6)," Total Active/Inactive Tests in File 60"
+50 WRITE !,$JUSTIFY(ZCNT,6)," INACTIVE Tests (",$EXTRACT(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
+51 ;
+52 WRITE !!,$JUSTIFY(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
+53 WRITE !,$JUSTIFY(NSPEC,6)," Active Tests w/o Specimens in File 60"
+54 WRITE !,$JUSTIFY(SCNT+NSPEC,6)," Total Entries to Map in File 60"
+55 ;
+56 WRITE !!,$JUSTIFY(NCNT,6)," Tests/Specimens (",$EXTRACT(NCNT/SCNT*100,1,5),"%) NOT Mapped"
+57 WRITE !,$JUSTIFY(PCNT,6)," Tests w/o Specimens (",$EXTRACT(PCNT/NSPEC*100,1,5),"%) NOT Mapped"
+58 QUIT
+59 ;
+60 ;======================================================================================
+61 ;
INIT ; Initialize variables
+1 DO ^XBCLS
+2 SET CM=","
SET (D0,D1,D2,PG,Q,Q1,R1)=0
+3 SET (ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT)=0
+4 SET (HDR,HDR1,HDR2,HDR3,LOINC,NAME,R,SPNM,UDL,UNITS)=""
+5 SET NOW=$$HTE^XLFDT($HOROLOG)
+6 QUIT
+7 ;
HDR ; Print appropriate header
+1 WRITE !!,$$CJ^XLFSTR(HDR,IOM)
+2 FOR I=1:1:$LENGTH(HDR)
SET UDL=UDL_"="
+3 WRITE !,$$CJ^XLFSTR(UDL,IOM)
+4 QUIT
+5 ;
CR ; Prompt to continue or exit
+1 ;S DIR(0)="^",DIR("A")="Enter RETURN to continue or '^' to exit"
+2 ;D ^DIR K DIR
+3 ;I +Y S Q1=1 Q
+4 ;S $Y=0 Q
+5 WRITE !,"Enter RETURN to continue or '^' to exit: "
READ ANS:30
+6 IF ANS="^"
SET Q1=1
QUIT
+7 IF ANS=""
SET $Y=0
QUIT
+8 DO CR
+9 QUIT
