Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRLRPT

BLRLRPT.m

Go to the documentation of this file. 
  1. BLRLRPT ; IHS/OIT/MPW - LOINC Mapping to File 60 Tests ; [ JUN 29, 2010  ]
  1.  ;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
  1.  ;;This routine prints reports for tests in File 60 that are mapped or not mapped to LOINC.
  1.  ;
  1.  ; Temporary Globals
  1.  ; -----------------
  1.  ; ^XTMP("BLRLRPT","LOINC")      - Holds mapped tests
  1.  ; ^XTMP("BLRLRPT","NO LOINC")   - Holds non-mapped tests
  1.  ;
  1.  ; Local Variables
  1.  ; ---------------
  1.  ; ACNT  - Counter of all ACTIVE tests in File 60
  1.  ; CCNT  - Counter of tests mapped to C80 LOINC codes
  1.  ; CNT   - Counter of all tests (active and inactive) in File 60
  1.  ; D0    - Test IEN from File 60
  1.  ; D1    - Specimen IEN from File 60
  1.  ; GCNT  - Counter of C80 LOINC codes mapped to File 60
  1.  ; ICNT  - Counter of IHS(non-specimen) LOINC codes
  1.  ; LCNT  - Counter of specimen-specific LOINC codes
  1.  ; LOINC - LOINC code
  1.  ; NAME  - Test name from File 60
  1.  ; NCNT  - Counter of tests w/o LOINC codes
  1.  ; NSPEC - Counter of tests w/o specimens (includes cosmic)
  1.  ; PCNT  - Counter of cosmic tests w/o LOINC codes
  1.  ; SCNT  - Counter of all specimens in File 60
  1.  ; SPNM  - Specimen name from File 61, defaults to SPECXXX
  1.  ; UNITS - Units from File 60, defaults to UNITXXX
  1.  ; ZCNT  - Counter of inactive tests in File 60, not mapped
  1.  ;
  1.  ;Must enter via proper tag/menu option
  1.  Q
  1.  ;
  1. PRNT ; Print File 60 tests mapped/not mapped to LOINC code
  1.  ;
  1.  ; Reset temporary globals
  1.  K ^XTMP("BLRLRPT")
  1.  ;
  1.  ; Initialize variables
  1.  N ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT
  1.  N HDR,HDR1,HDR2,HDR3,LOINC,NAME,NOW,Q,Q1,R,R1,SPNM,UDL,UNITS
  1.  D INIT
  1.  ;
  1.  S HDR="Print Lab Tests Mapped/Not Mapped to LOINC Codes" D HDR
  1.  W !!,"1. Print Tests Mapped to LOINC"
  1.  W !,"2. Print Tests NOT Mapped to LOINC"
  1.  W !!,"Enter selection # or '^' to quit: " R R:30 Q:R="^"!(R="")
  1.  I "1 2"'[R W !!,"Invalid Entry" H 2 G PRNT
  1.  S OPT="OPT"_R D @OPT
  1.  ;
  1.  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
  1.  Q
  1.  ;
  1. OPT1 ; Print Lab Tests Mapped to LOINC Codes
  1.  ;
  1.  ;Gather data from File 60
  1.  F  S D0=$O(^LAB(60,D0)) Q:Q1!(D0'=+D0)  D
  1.  .S CNT=CNT+1,NAME=$P(^LAB(60,D0,0),U,1),TYP=$P(^LAB(60,D0,0),U,3)
  1.  .;Don't report inactive tests
  1.  .I $E(NAME,1,2)="ZZ"!($E(NAME,1,2)="zz") S ZCNT=ZCNT+1 Q
  1.  .S ACNT=ACNT+1
  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
  1.  ..S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
  1.  ..S ICNT=ICNT+1,LOINC=$P(^LAB(60,D0,9999999),U,2)
  1.  ..S ^XTMP("BLRLRPT","LOINC","IHS",NAME)=LOINC_"-"_$P(^LAB(95.3,LOINC,0),U,15)
  1.  ..Q
  1.  .I $O(^LAB(60,D0,1,0))'="" S D1=0 D
  1.  ..F  S D1=$O(^LAB(60,D0,1,D1)) Q:D1=""!(D1'=+D1)  D
  1.  ...S SCNT=SCNT+1,SPNM=$S($D(^LAB(61,D1,0)):$P(^LAB(61,D1,0),U,1),1:"SPECXXX")
  1.  ...S UNITS=$P(^LAB(60,D0,1,D1,0),U,7) I UNITS="" S UNITS="UNITXXX"
  1.  ...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)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;Print results
  1.  S DIR(0)="Y",DIR("A")="Ready to capture output to a file",DIR("B")="Y"
  1.  D ^DIR K DIR
  1.  S R1=+Y
  1.  D ^XBCLS
  1.  S HDR="FILE 60 TESTS WITH LOINC CODES"
  1.  S HDR1=$G(NOW)
  1.  S HDR2="TEST NAME                       SPECIMEN      UNITS                   LOINC"
  1.  S HDR3="================================================================================"
  1.  W !!,$$CJ^XLFSTR(HDR,IOM)
  1.  S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
  1.  W !!,HDR2,!,HDR3
  1.  S NAME=""
  1.  F  S NAME=$O(^XTMP("BLRLRPT","LOINC",NAME)) Q:NAME=""!Q1  D
  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
  1.  .I R1,$Y>56 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
  1.  .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
  1.  .S SPNM="" F  S SPNM=$O(^XTMP("BLRLRPT","LOINC",NAME,SPNM)) Q:SPNM=""  D
  1.  ..S UNITS=""  F  S UNITS=$O(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)) Q:UNITS=""  D
  1.  ...S LOINC=$G(^XTMP("BLRLRPT","LOINC",NAME,SPNM,UNITS)),LNC=$P(LOINC,"-",1) W !,NAME,?32,$E(SPNM,1,12),?46,UNITS,?70,LOINC
  1.  ...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)=""
  1.  ...W !,?2,$G(^LAB(95.3,LNC,80)),!
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;Print any non-specimen LOINCed tests
  1.  I $D(^XTMP("BLRLRPT","LOINC","IHS"))&('Q1) D
  1.  .D ^XBCLS
  1.  .S HDR2="TEST NAME (CATAGORY)            LOINC"
  1.  .S HDR3="================================================================================"
  1.  .W !!,$$CJ^XLFSTR(HDR,IOM)
  1.  .S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
  1.  .W !!,HDR2,!,HDR3
  1.  .S NAME="" F  S NAME=$O(^XTMP("BLRLRPT","LOINC","IHS",NAME)) Q:NAME=""!(Q1)  D
  1.  ..S LOINC=$G(^XTMP("BLRLRPT","LOINC","IHS",NAME)),LNC=$P(LOINC,"-",1)
  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
  1.  ..I R1,$Y>56 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
  1.  ..W !,NAME,?32,LOINC,!,?2,$G(^LAB(95.3,LNC,80)),!
  1.  ..Q
  1.  .Q
  1.  ;Print summary
  1.  W !!,$J(CNT,6)," Total Active/Inactive Tests in File 60"
  1.  W !,$J(ZCNT,6)," INACTIVE Tests (",$E(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
  1.  ;
  1.  W !!,$J(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
  1.  W !,$J(NSPEC,6)," Active Tests w/o Specimens in File 60"
  1.  W !,$J(SCNT+NSPEC,6)," Total Entries to Map in File 60"
  1.  ;
  1.  W !!,$J(LCNT,6)," Tests w/ Specimens (",$E(LCNT/SCNT*100,1,5),"%) Mapped"
  1.  W !,$J(ICNT,6)," Tests w/o Specimens (",$E(ICNT/NSPEC*100,1,5),"%) Mapped"
  1.  W !,$J(LCNT+ICNT,6)," Total Entries (",$E((LCNT+ICNT)/(SCNT+NSPEC)*100,1,5),"%) Mapped"
  1.  ;
  1.  W !!,$J(CCNT,6)," Entries (",$E(CCNT/ACNT*100,1,5),"%) Mapped to C80 LOINC Codes"
  1.  W !,$J(GCNT,6)," C80 LOINC Codes (",$E(GCNT/290*100,1,5),"%) Mapped to File 60"
  1.  Q
  1.  ;
  1. OPT2 ; Print Lab Tests NOT Mapped to LOINC Codes
  1.  ;
  1.  ;Gather data from File 60
  1.  F  S D0=$O(^LAB(60,D0)) Q:Q1!(D0'=+D0)  D
  1.  .S CNT=CNT+1,NAME=$P(^LAB(60,D0,0),U,1),TYP=$P(^LAB(60,D0,0),U,3)
  1.  .;Don't report inactive tests
  1.  .I $E(NAME,1,2)="ZZ"!($E(NAME,1,2)="zz") S ZCNT=ZCNT+1 Q
  1.  .S ACNT=ACNT+1
  1.  .I $O(^LAB(60,D0,1,0))="" S NSPEC=NSPEC+1 D
  1.  ..I '$D(^LAB(60,D0,9999999)) D
  1.  ...S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
  1.  ...S PCNT=PCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME)=""
  1.  ...Q
  1.  ..I $D(^LAB(60,D0,9999999)),$P(^LAB(60,D0,9999999),U,2)="" D
  1.  ...S NAME=$S($O(^LAB(60,D0,2,0))'="":NAME_" (PANEL)",1:NAME_" ("_$P(^LAB(60,D0,0),U,4)_")")
  1.  ...S PCNT=PCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME)=""
  1.  ...Q
  1.  ..Q
  1.  .I $O(^LAB(60,D0,1,0))'="" S D1=0 D
  1.  ..F  S D1=$O(^LAB(60,D0,1,D1)) Q:D1=""!(D1'=+D1)  D
  1.  ...S SCNT=SCNT+1,SPNM=$S($D(^LAB(61,D1,0)):$P(^LAB(61,D1,0),U,1),1:"SPECXXX")
  1.  ...S UNITS=$P(^LAB(60,D0,1,D1,0),U,7) I UNITS="" S UNITS="UNITXXX"
  1.  ...I $G(^LAB(60,D0,1,D1,95.3))="" S NCNT=NCNT+1,^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,UNITS)=""
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;Print results
  1.  S DIR(0)="Y",DIR("A")="Ready to capture output to a file",DIR("B")="Y"
  1.  D ^DIR K DIR
  1.  S R1=+Y
  1.  D ^XBCLS
  1.  S HDR="FILE 60 TESTS WITHOUT LOINC CODES"
  1.  S HDR1=$G(NOW)
  1.  S HDR2="TEST NAME (CATAGORY)                          SPECIMEN      UNITS"
  1.  S HDR3="================================================================================"
  1.  W !!,$$CJ^XLFSTR(HDR,IOM)
  1.  S PG=PG+1 W !,?5,HDR1,?70,"PAGE: ",PG
  1.  W !!,HDR2,!,HDR3
  1.  S NAME=""
  1.  F  S NAME=$O(^XTMP("BLRLRPT","NO LOINC",NAME)) Q:NAME=""!Q1  D
  1.  .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
  1.  .I R1,$Y>57 S $Y=0,PG=PG+1 W !,$$CJ^XLFSTR(HDR,IOM),!,?5,HDR1,?70,"PAGE: ",PG,!!,HDR2,!,HDR3
  1.  .I $D(^XTMP("BLRLRPT","NO LOINC",NAME))=1 W !,NAME Q
  1.  .S SPNM="" F  S SPNM=$O(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM)) Q:SPNM=""  D
  1.  ..S UNITS=$O(^XTMP("BLRLRPT","NO LOINC",NAME,SPNM,"")) W !,NAME,?46,$E(SPNM,1,12),?60,UNITS
  1.  ..Q
  1.  .Q
  1.  ;Print summary
  1.  W !!,$J(CNT,6)," Total Active/Inactive Tests in File 60"
  1.  W !,$J(ZCNT,6)," INACTIVE Tests (",$E(ZCNT/CNT*100,1,5),"%) Will NOT be Mapped"
  1.  ;
  1.  W !!,$J(ACNT-NSPEC,6)," Active Tests with ",SCNT," Specimens in File 60"
  1.  W !,$J(NSPEC,6)," Active Tests w/o Specimens in File 60"
  1.  W !,$J(SCNT+NSPEC,6)," Total Entries to Map in File 60"
  1.  ;
  1.  W !!,$J(NCNT,6)," Tests/Specimens (",$E(NCNT/SCNT*100,1,5),"%) NOT Mapped"
  1.  W !,$J(PCNT,6)," Tests w/o Specimens (",$E(PCNT/NSPEC*100,1,5),"%) NOT Mapped"
  1.  Q
  1.  ;
  1.  ;======================================================================================
  1.  ;
  1. INIT ; Initialize variables
  1.  D ^XBCLS
  1.  S CM=",",(D0,D1,D2,PG,Q,Q1,R1)=0
  1.  S (ACNT,CNT,CCNT,GCNT,ICNT,LCNT,NCNT,NSPEC,PCNT,SCNT,SPN,ZCNT)=0
  1.  S (HDR,HDR1,HDR2,HDR3,LOINC,NAME,R,SPNM,UDL,UNITS)=""
  1.  S NOW=$$HTE^XLFDT($H)
  1.  Q
  1.  ;
  1. HDR ; Print appropriate header
  1.  W !!,$$CJ^XLFSTR(HDR,IOM)
  1.  F I=1:1:$L(HDR) S UDL=UDL_"="
  1.  W !,$$CJ^XLFSTR(UDL,IOM)
  1.  Q
  1.  ;
  1. CR ; Prompt to continue or exit
  1.  ;S DIR(0)="^",DIR("A")="Enter RETURN to continue or '^' to exit"
  1.  ;D ^DIR K DIR
  1.  ;I +Y S Q1=1 Q
  1.  ;S $Y=0 Q
  1.  W !,"Enter RETURN to continue or '^' to exit: " R ANS:30
  1.  I ANS="^" S Q1=1 Q
  1.  I ANS="" S $Y=0 Q
  1.  D CR
  1.  Q