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

BLRUCUM.m

Go to the documentation of this file. 
  1. BLRUCUM ; IHS/OIT/MPW - Link units field in File 60 to UCUM codes ; [ 12/10/2010  4:00 PM ]
  1.  ;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
  1.  ;
  1.  ; This routine goes through the LABORATORY TESTS file (#60) and verifies that the contents of the units field under the 
  1.  ; site/specimen sub-field can be linked to a valid UCUM entry found in a new IHS UCUM file (#90475.3).
  1.  ;
  1.  ; When completed, a summary report displays the outcome of the verification process and the user is prompted to request 
  1.  ; a detailed report of units verified based on either tests or units.
  1.  ; 
  1.  ; Temporary globals for exceptions report:  
  1.  ; ^XTMP("BLRUCUM","ERR","PANEL")  -- Panels without specimens and units
  1.  ; ^XTMP("BLRUCUM","ERR","NSPEC")  -- No specimen found, skipped
  1.  ; ^XTMP("BLRUCUM","ERR","NUNIT")  -- No units found, skipped
  1.  ; ^XTMP("BLRUCUM","ERR","NUCUM")  -- No UCUM equivalent found
  1.  ; 
  1.  ; Temporary globals for results reports:
  1.  ; ^XTMP("BLRUCUM","LOG")=CNT^SPEC, Total numbers of tests and specimens in File 60
  1.  ; ^XTMP("BLRUCUM","LOG","TEST")=TCNT, # of tests that had units verified
  1.  ; ^XTMP("BLRUCUM","LOG","TEST",test,specimen)=units
  1.  ; ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT, total # of units verified
  1.  ; ^XTMP("BLRUCUM","LOG","UNITS",units,UCUM)= # of instances verified for this unit
  1.  ;
  1.  ; Local Variables
  1.  ; ---------------
  1.  ; CNT   - # of tests in File 60
  1.  ; DONE  - Flag = $H completed or 0 if not completed
  1.  ; ETYP  - Exceptions type, branch of ERR global: NSPEC, NUNIT or NUCUM
  1.  ; NAME  - Test name
  1.  ; NCNT  - # of specimens without units (ETYP=NUNIT)
  1.  ; OKCNT - # of units verified and tied to UCUM
  1.  ; RES   - Prompt response
  1.  ; SIEN  - Specimen IEN in File 60
  1.  ; SCNT  - # of tests without specimens (ETYP=NSPEC)
  1.  ; SPEC  - # of specimens in File 60
  1.  ; SPNM  - Specimen description from File 61
  1.  ; SWU   - Specimens with units
  1.  ; TCNT  - Total number of tests with units verified
  1.  ; TIEN  - Test IEN in File 60
  1.  ; UCNT  - # of units with no UCUM equivalent (ETYP=NUCUM)
  1.  ; UNITS - Units stored in each site/specimen node
  1.  ; UCUM  - UCUM formatted units tied to UID in File 90475.3
  1.  ; UID   - IEN of UCUM code in File 90475.3
  1.  ; ZCNT  - # of inactive tests skipped
  1.  ; ===============================================================================================
  1.  ;
  1.  ; Initialize variables
  1.  D INIT
  1.  ;
  1.  ; Print header
  1.  D HDR
  1.  ;
  1.  ; Display message if conversion has already been run
  1.  D:DONE CMP
  1.  ;
  1.  ; Prompt for detailed results, if present
  1.  I $D(^XTMP("BLRUCUM","LOG")) D
  1.  .I DONE W !!,"RESULTS OF UNIT VERIFICATION ARE AVAILABLE"
  1.  .W !!,"Display Detailed Results by Test, Units or Both? (T/U/B): " R RES:30
  1.  .D:RES="T" TRPT D:RES="U" URPT D:RES="B" TRPT,URPT
  1.  .Q
  1.  ;
  1.  S DIR(0)="Y",DIR("A")="Verify Units Linked to UCUM",DIR("B")="N" K DA D ^DIR K DIR
  1.  I 'Y Q
  1.  ;
  1.  ; Reset global and reinitialize variables for verification
  1.  K ^XTMP("BLRUCUM")
  1.  D INIT
  1.  ;
  1.  S TIEN=0 F  S TIEN=$O(^LAB(60,TIEN)) Q:TIEN'=+TIEN  S CNT=CNT+1 W "." D
  1.  .S NAME=$P(^LAB(60,TIEN,0),U,1) I $E(NAME,1,2)="ZZ"!($E(NAME,1,2)="zz") S ZCNT=ZCNT+1 Q
  1.  .I $O(^LAB(60,TIEN,2,0)) S ETYP="PANEL" D ERR Q
  1.  .I $O(^LAB(60,TIEN,1,0))="" S ETYP="NSPEC" D ERR Q
  1.  .S SIEN=0 F  S SIEN=$O(^LAB(60,TIEN,1,SIEN)) Q:SIEN'=+SIEN  D
  1.  ..S SPEC=SPEC+1
  1.  ..S UNITS=$P(^LAB(60,TIEN,1,SIEN,0),U,7),UNITS=$TR(UNITS,QT,""),UNITS=$$TRIMALL(UNITS)
  1.  ..I UNITS="" S ETYP="NUNIT" D ERR Q
  1.  ..I '$D(^BLRUCUM("B",UNITS))&('$D(^BLRUCUM("D",UNITS))) S ETYP="NUCUM" D ERR Q
  1.  ..S UID=$S($D(^BLRUCUM("B",UNITS)):$O(^BLRUCUM("B",UNITS,"")),$D(^BLRUCUM("D",UNITS)):$O(^BLRUCUM("D",UNITS,"")),1:"")
  1.  ..Q:UID=""
  1.  ..S UCUM=$P(^BLRUCUM(UID,0),U,1) D LOG
  1.  ..Q
  1.  .Q
  1.  ; Print completion message
  1.  W !!,"Verification of Units Linked to UCUM Completed"
  1.  S ^XTMP("BLRUCUM","LOG")=CNT_U_SPEC
  1.  S ^XTMP("BLRUCUM","LOG","INACT")=ZCNT
  1.  S ^XTMP("BLRUCUM","LOG","TEST")=TCNT
  1.  S ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT
  1.  S ^XTMP("BLRUCUM","DONE")=$H
  1.  ;
  1.  ; Print summary report
  1.  D SRPT
  1.  ;
  1.  ; Prompt for detailed results report
  1.  I $D(^XTMP("BLRUCUM","LOG")) D
  1.  .W !!,"Display Detailed Results for File 60 by Test, Units or Both? (T/U/B): " R RES:30
  1.  .D:RES="T" TRPT D:RES="U" URPT D:RES="B" TRPT,URPT
  1.  .Q
  1.  ;
  1.  I $D(^XTMP("BLRUCUM","ERR")) D
  1.  .W !!,"Print Exceptions Report? (Y/<N>): " R RES:30 S RES=$S(RES="Y":1,1:0)
  1.  .I RES D ERPT
  1.  .Q
  1.  Q
  1.  ;
  1. INIT ; Clear the screen and initialize variables
  1.  D ^XBCLS
  1.  S U1=":",U2=";",CM=",",QT=""""
  1.  S (CNT,DRPT,OKCNT,PCNT,RES,TCNT,TIEN,SIEN,SPEC,Q,Q1,ZCNT)=0
  1.  S (ETYP,HDR,NAME,SPNM,UCUM,UID,UNITS,UNL)=""
  1.  S TODAY=$$HTFM^XLFDT($H,1)
  1.  S PURGE=$$HTFM^XLFDT($P($H,CM,1)+90,1)
  1.  I '$D(^XTMP("BLRUCUM")) S ^XTMP("BLRUCUM",0)=PURGE_U_TODAY_U_"UCUM VERIFICATION"
  1.  S DONE=+$G(^XTMP("BLRUCUM","DONE"))
  1.  Q
  1.  ;
  1. HDR ; Print header
  1.  S HDR="VERIFY FILE 60 UNITS LINKED TO UCUM"
  1.  S UNL="==================================="
  1.  W !!,$$CJ^XLFSTR(HDR,IOM)
  1.  W !,$$CJ^XLFSTR(UNL,IOM)
  1.  Q
  1.  ;
  1. CMP ; Verification completed display
  1.  S CHDR="Verification of Units Linked to UCUM completed on "_$$HTE^XLFDT(DONE)
  1.  D ^XBON
  1.  W !!,$$CJ^XLFSTR(CHDR,IOM)
  1.  D ^XBOFF
  1.  Q
  1.  ;
  1. CR ;
  1.  S Q1=0
  1.  W !,"Enter RETURN to continue or '^' to exit:" R RES:30
  1.  I RES="^" S Q1=1 Q
  1.  I RES="" S $Y=0 Q
  1.  D CR
  1.  Q
  1.  ;
  1. ERR ; Log exceptions for File 60 verification
  1.  I ETYP="NSPEC"!(ETYP="PANEL") S ^XTMP("BLRUCUM","ERR",ETYP,TIEN)=""
  1.  I ETYP="NUNIT"!(ETYP="NUCUM") S ^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN)=$G(UNITS)
  1.  S ^XTMP("BLRUCUM","ERR",ETYP)=+$G(^XTMP("BLRUCUM","ERR",ETYP))+1
  1.  Q
  1.  ;
  1. LOG ; Log tests with units verified, by test,specimen and by units,UCUM
  1.  I '$D(^XTMP("BLRUCUM","LOG","TEST",TIEN)) S TCNT=TCNT+1,^XTMP("BLRUCUM","LOG","TEST")=TCNT
  1.  I '$D(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)) S OKCNT=OKCNT+1
  1.  S ^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)=$G(UNITS)_U_$G(UCUM)
  1.  S ^XTMP("BLRUCUM","LOG","UNITS")=+$G(^XTMP("BLRUCUM","LOG","UNITS"))+1
  1.  S ^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM)=+$G(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))+1
  1.  Q
  1.  ;
  1. SRPT ; Summary Report
  1.  D ^XBCLS
  1.  S PCNT=+$G(^XTMP("BLRUCUM","ERR","PANEL"))
  1.  S SCNT=+$G(^XTMP("BLRUCUM","ERR","NSPEC"))
  1.  S NCNT=+$G(^XTMP("BLRUCUM","ERR","NUNIT"))
  1.  S UCNT=+$G(^XTMP("BLRUCUM","ERR","NUCUM"))
  1.  S ZCNT=+$G(^XTMP("BLRUCUM","LOG","INACT"))
  1.  I $G(^XTMP("BLRUCUM","LOG"))'="" S CNT=+$P(^XTMP("BLRUCUM","LOG"),U,1),SPEC=+$P(^XTMP("BLRUCUM","LOG"),U,2)
  1.  S OKCNT=+$G(^XTMP("BLRUCUM","LOG","UNITS"))
  1.  S SWU=+$G(SPEC)-(+$G(NCNT))
  1.  W !,$$CJ^XLFSTR("UNITS LINKED TO UCUM - RESULTS SUMMARY",IOM)
  1.  W !,$$CJ^XLFSTR("======================================",IOM)
  1.  ;
  1.  W !!,$J(CNT,5),?7,"TESTS and ",SPEC," SPECIMENS examined in File 60"
  1.  W !,$J(OKCNT,5),?7 W:SWU>0 "(",$E((OKCNT/SWU*100),1,5),"%)" W " UNITS linked to UCUM"
  1.  ;
  1.  ; Print error summary
  1.  W !!,$$CJ^XLFSTR("Summary of Exceptions",IOM)
  1.  W !,$$CJ^XLFSTR("---------------------",IOM)
  1.  W !,$J(ZCNT,5),?7 W:CNT>0 "(",$E((ZCNT/CNT*100),1,5),"%)" W " INACTIVE TESTS skipped"
  1.  W !,$J(PCNT,5),?7 W:CNT>0 "(",$E((PCNT/CNT*100),1,5),"%)" W " PANELS skipped"
  1.  W !,$J(SCNT,5),?7 W:CNT>0 "(",$E((SCNT/CNT*100),1,5),"%)" W " TESTS w/o specimens skipped"
  1.  W !,$J(NCNT,5),?7 W:SPEC>0 "(",$E((NCNT/SPEC*100),1,5),"%)" W " SPECIMENS w/o units skipped"
  1.  W !,$J(UCNT,5),?7 W:OKCNT>0 "(",$E((UCNT/(UCNT+OKCNT)*100),1,5),"%)" W " UNITS not linked to UCUM"
  1.  Q
  1. TRPT ; Display detailed results by test
  1.  S DONE=+$G(^XTMP("BLRUCUM","DONE"))
  1.  S TCNT=+$G(^XTMP("BLRUCUM","LOG","TEST"))
  1.  D ^XBCLS
  1.  D THDR
  1.  S TIEN="",Q1=0
  1.  F  S TIEN=$O(^XTMP("BLRUCUM","LOG","TEST",TIEN)) Q:Q1!(TIEN="")  D
  1.  .S SIEN="" F  S SIEN=$O(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)) Q:Q1!(SIEN="")  D
  1.  ..S TST=$P(^LAB(60,TIEN,0),U,1)
  1.  ..S SPNM=$P(^LAB(61,SIEN,0),U,1)
  1.  ..S UNITS=$P($G(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,1)
  1.  ..S UCUM=$P($G(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,2)
  1.  ..W !,?3,TIEN,?10,$E(TST,1,23),?35,$E(SPNM,1,13),?50,UNITS,?65,UCUM
  1.  ..I $Y>22 D CR Q:Q1  D THDR
  1.  ..Q
  1.  .Q
  1.  W !!,?3,TCNT," Tests with Units Linked to UCUM"
  1.  D CR Q:Q1
  1.  Q
  1.  ;
  1. URPT ; Print detailed results by units
  1.  S UCNT=+$G(^XTMP("BLRUCUM","LOG","UNITS"))
  1.  D ^XBCLS
  1.  D UHDR
  1.  S UNITS="",Q1=0
  1.  F  S UNITS=$O(^XTMP("BLRUCUM","LOG","UNITS",UNITS)) Q:UNITS=""!(Q1)  D
  1.  .S UCUM=$O(^XTMP("BLRUCUM","LOG","UNITS",UNITS,"")) Q:UCUM=""
  1.  .S UID=$O(^BLRUCUM("B",UCUM,""))
  1.  .S CNT=+$G(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))
  1.  .W !,?25,CNT,?32,"'"_UNITS_"'",?50,UCUM
  1.  .I $Y>22 D CR Q:Q1  D UHDR
  1.  .Q
  1.  W !!,?3,UCNT," Units Linked to UCUM"
  1.  D CR Q:Q1
  1.  Q
  1.  ;
  1. THDR ; Print Header for File 60 Test Report
  1.  W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY TEST",IOM)
  1.  W !,$$CJ^XLFSTR("===============================================",IOM)
  1.  W !!,?3,"IEN",?10,"TEST",?35,"SPECIMEN",?50,"UNITS",?65,"UCUM"
  1.  W !,"--------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. UHDR ; Print Header for File 60 Units Report
  1.  W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY UNITS",IOM)
  1.  W !,$$CJ^XLFSTR("================================================",IOM)
  1.  W !!,?24,"Instances of Units Linked to UCUM"
  1.  W !,?24,"----------------------------------"
  1.  Q
  1.  ; 
  1. ERPT ; Print Detailed Exceptions Report
  1.  I '$D(^XTMP("BLRUCUM","ERR")) W !!,$$CJ^XLFSTR("NO EXCEPTIONS TO REPORT",IOM) H 2 Q
  1.  ;
  1.  ; Print exceptions from File 60
  1.  S ETYP="A",Q1=0
  1.  F  S ETYP=$O(^XTMP("BLRUCUM","ERR",ETYP)) Q:Q1!(ETYP="")  D
  1.  .D ^XBCLS
  1.  .D EHDR
  1.  .S TIEN="",Q1=0
  1.  .F  S TIEN=$O(^XTMP("BLRUCUM","ERR",ETYP,TIEN)) Q:Q1!(TIEN="")  D
  1.  ..S TST=$P(^LAB(60,TIEN,0),U,1),SS=$P(^LAB(60,TIEN,0),U,4)
  1.  ..I $O(^LAB(60,TIEN,2,0)) S TST=TST_" (PANEL)"
  1.  ..W !,?3,TIEN,?15,$E(TST,1,23)_$S(SS'="":" ("_SS_")",1:"")
  1.  ..I ETYP="NUNIT"!(ETYP="NUCUM") S SIEN="",LN=1 D
  1.  ...F  S SIEN=$O(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN)) Q:Q1!(SIEN="")  D
  1.  ....S SPNM=$P(^LAB(61,SIEN,0),U,1),UNITS=$G(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN))
  1.  ....W:LN>1 ! W ?45,$E(SPNM,1,12) W:ETYP="NUCUM" ?60,$G(UNITS) S LN=LN+1
  1.  ....I $Y>22 D CR Q:Q1  D EHDR
  1.  ....Q
  1.  ...Q
  1.  ..I 'Q1,$Y>22 D CR Q:Q1  D EHDR
  1.  ..Q
  1.  .S TOT=+$G(^XTMP("BLRUCUM","ERR",ETYP))
  1.  .W !!,?3,TOT," ",HDR
  1.  .I $O(^XTMP("BLRUCUM","ERR",ETYP))="" W !!,$$CJ^XLFSTR("*** END OF REPORT ***",IOM) Q
  1.  .D CR Q:Q1
  1.  .Q
  1.  ;
  1.  Q
  1.  ;
  1. EHDR ; Print Header for Error Report
  1.  S (HDR,UNL)=""
  1.  W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- EXCEPTIONS REPORT",IOM)
  1.  I ETYP="NSPEC" S HDR="TESTS WITHOUT SPECIMENS - SKIPPED"
  1.  I ETYP="NUNIT" S HDR="SPECIMENS WITHOUT UNITS - SKIPPED"
  1.  I ETYP="NUCUM" S HDR="UNITS NOT LINKED TO UCUM"
  1.  I ETYP="PANEL" S HDR="PANELS - SKIPPED"
  1.  W !,$$CJ^XLFSTR(HDR,IOM)
  1.  W !,$$CJ^XLFSTR("================================================",IOM)
  1.  W !!,?3,"IEN",?15,"TEST (CATEGORY)" W:ETYP="NUNIT"!(ETYP="NUCUM") ?45,"SPECIMEN" W:ETYP="NUCUM" ?60,"UNITS"
  1.  W !,"--------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1.  ;Trim Leading Spaces
  1. TRIMLSPC(X) ;
  1.  F  Q:$E(X,1)'=" "  S X=$E(X,2,$L(X))
  1.  Q X
  1.  ;--------------------------------------------------------------------
  1.  ;Trim Trailing Spaces
  1. TRIMTSPC(X) ;
  1.  F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,$L(X)-1)
  1.  Q X
  1.  ;--------------------------------------------------------------------
  1.  ;
  1.  ;Trim All Leading and Trailing Spaces
  1. TRIMALL(X) ;
  1.  Q $$TRIMLSPC($$TRIMTSPC(X))
  1.  ;
  1.  ;============================================================================================