BLRUCUM ; IHS/OIT/MPW - Link units field in File 60 to UCUM codes ; [ 12/10/2010 4:00 PM ]
;;5.2;IHS LABORATORY;**1028**;NOV 01, 1997;Build 46
;
; This routine goes through the LABORATORY TESTS file (#60) and verifies that the contents of the units field under the
; site/specimen sub-field can be linked to a valid UCUM entry found in a new IHS UCUM file (#90475.3).
;
; When completed, a summary report displays the outcome of the verification process and the user is prompted to request
; a detailed report of units verified based on either tests or units.
;
; Temporary globals for exceptions report:
; ^XTMP("BLRUCUM","ERR","PANEL") -- Panels without specimens and units
; ^XTMP("BLRUCUM","ERR","NSPEC") -- No specimen found, skipped
; ^XTMP("BLRUCUM","ERR","NUNIT") -- No units found, skipped
; ^XTMP("BLRUCUM","ERR","NUCUM") -- No UCUM equivalent found
;
; Temporary globals for results reports:
; ^XTMP("BLRUCUM","LOG")=CNT^SPEC, Total numbers of tests and specimens in File 60
; ^XTMP("BLRUCUM","LOG","TEST")=TCNT, # of tests that had units verified
; ^XTMP("BLRUCUM","LOG","TEST",test,specimen)=units
; ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT, total # of units verified
; ^XTMP("BLRUCUM","LOG","UNITS",units,UCUM)= # of instances verified for this unit
;
; Local Variables
; ---------------
; CNT - # of tests in File 60
; DONE - Flag = $H completed or 0 if not completed
; ETYP - Exceptions type, branch of ERR global: NSPEC, NUNIT or NUCUM
; NAME - Test name
; NCNT - # of specimens without units (ETYP=NUNIT)
; OKCNT - # of units verified and tied to UCUM
; RES - Prompt response
; SIEN - Specimen IEN in File 60
; SCNT - # of tests without specimens (ETYP=NSPEC)
; SPEC - # of specimens in File 60
; SPNM - Specimen description from File 61
; SWU - Specimens with units
; TCNT - Total number of tests with units verified
; TIEN - Test IEN in File 60
; UCNT - # of units with no UCUM equivalent (ETYP=NUCUM)
; UNITS - Units stored in each site/specimen node
; UCUM - UCUM formatted units tied to UID in File 90475.3
; UID - IEN of UCUM code in File 90475.3
; ZCNT - # of inactive tests skipped
; ===============================================================================================
;
; Initialize variables
D INIT
;
; Print header
D HDR
;
; Display message if conversion has already been run
D:DONE CMP
;
; Prompt for detailed results, if present
I $D(^XTMP("BLRUCUM","LOG")) D
.I DONE W !!,"RESULTS OF UNIT VERIFICATION ARE AVAILABLE"
.W !!,"Display Detailed Results by Test, Units or Both? (T/U/B): " R RES:30
.D:RES="T" TRPT D:RES="U" URPT D:RES="B" TRPT,URPT
.Q
;
S DIR(0)="Y",DIR("A")="Verify Units Linked to UCUM",DIR("B")="N" K DA D ^DIR K DIR
I 'Y Q
;
; Reset global and reinitialize variables for verification
K ^XTMP("BLRUCUM")
D INIT
;
S TIEN=0 F S TIEN=$O(^LAB(60,TIEN)) Q:TIEN'=+TIEN S CNT=CNT+1 W "." D
.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
.I $O(^LAB(60,TIEN,2,0)) S ETYP="PANEL" D ERR Q
.I $O(^LAB(60,TIEN,1,0))="" S ETYP="NSPEC" D ERR Q
.S SIEN=0 F S SIEN=$O(^LAB(60,TIEN,1,SIEN)) Q:SIEN'=+SIEN D
..S SPEC=SPEC+1
..S UNITS=$P(^LAB(60,TIEN,1,SIEN,0),U,7),UNITS=$TR(UNITS,QT,""),UNITS=$$TRIMALL(UNITS)
..I UNITS="" S ETYP="NUNIT" D ERR Q
..I '$D(^BLRUCUM("B",UNITS))&('$D(^BLRUCUM("D",UNITS))) S ETYP="NUCUM" D ERR Q
..S UID=$S($D(^BLRUCUM("B",UNITS)):$O(^BLRUCUM("B",UNITS,"")),$D(^BLRUCUM("D",UNITS)):$O(^BLRUCUM("D",UNITS,"")),1:"")
..Q:UID=""
..S UCUM=$P(^BLRUCUM(UID,0),U,1) D LOG
..Q
.Q
; Print completion message
W !!,"Verification of Units Linked to UCUM Completed"
S ^XTMP("BLRUCUM","LOG")=CNT_U_SPEC
S ^XTMP("BLRUCUM","LOG","INACT")=ZCNT
S ^XTMP("BLRUCUM","LOG","TEST")=TCNT
S ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT
S ^XTMP("BLRUCUM","DONE")=$H
;
; Print summary report
D SRPT
;
; Prompt for detailed results report
I $D(^XTMP("BLRUCUM","LOG")) D
.W !!,"Display Detailed Results for File 60 by Test, Units or Both? (T/U/B): " R RES:30
.D:RES="T" TRPT D:RES="U" URPT D:RES="B" TRPT,URPT
.Q
;
I $D(^XTMP("BLRUCUM","ERR")) D
.W !!,"Print Exceptions Report? (Y/<N>): " R RES:30 S RES=$S(RES="Y":1,1:0)
.I RES D ERPT
.Q
Q
;
INIT ; Clear the screen and initialize variables
D ^XBCLS
S U1=":",U2=";",CM=",",QT=""""
S (CNT,DRPT,OKCNT,PCNT,RES,TCNT,TIEN,SIEN,SPEC,Q,Q1,ZCNT)=0
S (ETYP,HDR,NAME,SPNM,UCUM,UID,UNITS,UNL)=""
S TODAY=$$HTFM^XLFDT($H,1)
S PURGE=$$HTFM^XLFDT($P($H,CM,1)+90,1)
I '$D(^XTMP("BLRUCUM")) S ^XTMP("BLRUCUM",0)=PURGE_U_TODAY_U_"UCUM VERIFICATION"
S DONE=+$G(^XTMP("BLRUCUM","DONE"))
Q
;
HDR ; Print header
S HDR="VERIFY FILE 60 UNITS LINKED TO UCUM"
S UNL="==================================="
W !!,$$CJ^XLFSTR(HDR,IOM)
W !,$$CJ^XLFSTR(UNL,IOM)
Q
;
CMP ; Verification completed display
S CHDR="Verification of Units Linked to UCUM completed on "_$$HTE^XLFDT(DONE)
D ^XBON
W !!,$$CJ^XLFSTR(CHDR,IOM)
D ^XBOFF
Q
;
CR ;
S Q1=0
W !,"Enter RETURN to continue or '^' to exit:" R RES:30
I RES="^" S Q1=1 Q
I RES="" S $Y=0 Q
D CR
Q
;
ERR ; Log exceptions for File 60 verification
I ETYP="NSPEC"!(ETYP="PANEL") S ^XTMP("BLRUCUM","ERR",ETYP,TIEN)=""
I ETYP="NUNIT"!(ETYP="NUCUM") S ^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN)=$G(UNITS)
S ^XTMP("BLRUCUM","ERR",ETYP)=+$G(^XTMP("BLRUCUM","ERR",ETYP))+1
Q
;
LOG ; Log tests with units verified, by test,specimen and by units,UCUM
I '$D(^XTMP("BLRUCUM","LOG","TEST",TIEN)) S TCNT=TCNT+1,^XTMP("BLRUCUM","LOG","TEST")=TCNT
I '$D(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)) S OKCNT=OKCNT+1
S ^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)=$G(UNITS)_U_$G(UCUM)
S ^XTMP("BLRUCUM","LOG","UNITS")=+$G(^XTMP("BLRUCUM","LOG","UNITS"))+1
S ^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM)=+$G(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))+1
Q
;
SRPT ; Summary Report
D ^XBCLS
S PCNT=+$G(^XTMP("BLRUCUM","ERR","PANEL"))
S SCNT=+$G(^XTMP("BLRUCUM","ERR","NSPEC"))
S NCNT=+$G(^XTMP("BLRUCUM","ERR","NUNIT"))
S UCNT=+$G(^XTMP("BLRUCUM","ERR","NUCUM"))
S ZCNT=+$G(^XTMP("BLRUCUM","LOG","INACT"))
I $G(^XTMP("BLRUCUM","LOG"))'="" S CNT=+$P(^XTMP("BLRUCUM","LOG"),U,1),SPEC=+$P(^XTMP("BLRUCUM","LOG"),U,2)
S OKCNT=+$G(^XTMP("BLRUCUM","LOG","UNITS"))
S SWU=+$G(SPEC)-(+$G(NCNT))
W !,$$CJ^XLFSTR("UNITS LINKED TO UCUM - RESULTS SUMMARY",IOM)
W !,$$CJ^XLFSTR("======================================",IOM)
;
W !!,$J(CNT,5),?7,"TESTS and ",SPEC," SPECIMENS examined in File 60"
W !,$J(OKCNT,5),?7 W:SWU>0 "(",$E((OKCNT/SWU*100),1,5),"%)" W " UNITS linked to UCUM"
;
; Print error summary
W !!,$$CJ^XLFSTR("Summary of Exceptions",IOM)
W !,$$CJ^XLFSTR("---------------------",IOM)
W !,$J(ZCNT,5),?7 W:CNT>0 "(",$E((ZCNT/CNT*100),1,5),"%)" W " INACTIVE TESTS skipped"
W !,$J(PCNT,5),?7 W:CNT>0 "(",$E((PCNT/CNT*100),1,5),"%)" W " PANELS skipped"
W !,$J(SCNT,5),?7 W:CNT>0 "(",$E((SCNT/CNT*100),1,5),"%)" W " TESTS w/o specimens skipped"
W !,$J(NCNT,5),?7 W:SPEC>0 "(",$E((NCNT/SPEC*100),1,5),"%)" W " SPECIMENS w/o units skipped"
W !,$J(UCNT,5),?7 W:OKCNT>0 "(",$E((UCNT/(UCNT+OKCNT)*100),1,5),"%)" W " UNITS not linked to UCUM"
Q
TRPT ; Display detailed results by test
S DONE=+$G(^XTMP("BLRUCUM","DONE"))
S TCNT=+$G(^XTMP("BLRUCUM","LOG","TEST"))
D ^XBCLS
D THDR
S TIEN="",Q1=0
F S TIEN=$O(^XTMP("BLRUCUM","LOG","TEST",TIEN)) Q:Q1!(TIEN="") D
.S SIEN="" F S SIEN=$O(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)) Q:Q1!(SIEN="") D
..S TST=$P(^LAB(60,TIEN,0),U,1)
..S SPNM=$P(^LAB(61,SIEN,0),U,1)
..S UNITS=$P($G(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,1)
..S UCUM=$P($G(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,2)
..W !,?3,TIEN,?10,$E(TST,1,23),?35,$E(SPNM,1,13),?50,UNITS,?65,UCUM
..I $Y>22 D CR Q:Q1 D THDR
..Q
.Q
W !!,?3,TCNT," Tests with Units Linked to UCUM"
D CR Q:Q1
Q
;
URPT ; Print detailed results by units
S UCNT=+$G(^XTMP("BLRUCUM","LOG","UNITS"))
D ^XBCLS
D UHDR
S UNITS="",Q1=0
F S UNITS=$O(^XTMP("BLRUCUM","LOG","UNITS",UNITS)) Q:UNITS=""!(Q1) D
.S UCUM=$O(^XTMP("BLRUCUM","LOG","UNITS",UNITS,"")) Q:UCUM=""
.S UID=$O(^BLRUCUM("B",UCUM,""))
.S CNT=+$G(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))
.W !,?25,CNT,?32,"'"_UNITS_"'",?50,UCUM
.I $Y>22 D CR Q:Q1 D UHDR
.Q
W !!,?3,UCNT," Units Linked to UCUM"
D CR Q:Q1
Q
;
THDR ; Print Header for File 60 Test Report
W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY TEST",IOM)
W !,$$CJ^XLFSTR("===============================================",IOM)
W !!,?3,"IEN",?10,"TEST",?35,"SPECIMEN",?50,"UNITS",?65,"UCUM"
W !,"--------------------------------------------------------------------------------"
Q
;
UHDR ; Print Header for File 60 Units Report
W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY UNITS",IOM)
W !,$$CJ^XLFSTR("================================================",IOM)
W !!,?24,"Instances of Units Linked to UCUM"
W !,?24,"----------------------------------"
Q
;
ERPT ; Print Detailed Exceptions Report
I '$D(^XTMP("BLRUCUM","ERR")) W !!,$$CJ^XLFSTR("NO EXCEPTIONS TO REPORT",IOM) H 2 Q
;
; Print exceptions from File 60
S ETYP="A",Q1=0
F S ETYP=$O(^XTMP("BLRUCUM","ERR",ETYP)) Q:Q1!(ETYP="") D
.D ^XBCLS
.D EHDR
.S TIEN="",Q1=0
.F S TIEN=$O(^XTMP("BLRUCUM","ERR",ETYP,TIEN)) Q:Q1!(TIEN="") D
..S TST=$P(^LAB(60,TIEN,0),U,1),SS=$P(^LAB(60,TIEN,0),U,4)
..I $O(^LAB(60,TIEN,2,0)) S TST=TST_" (PANEL)"
..W !,?3,TIEN,?15,$E(TST,1,23)_$S(SS'="":" ("_SS_")",1:"")
..I ETYP="NUNIT"!(ETYP="NUCUM") S SIEN="",LN=1 D
...F S SIEN=$O(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN)) Q:Q1!(SIEN="") D
....S SPNM=$P(^LAB(61,SIEN,0),U,1),UNITS=$G(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN))
....W:LN>1 ! W ?45,$E(SPNM,1,12) W:ETYP="NUCUM" ?60,$G(UNITS) S LN=LN+1
....I $Y>22 D CR Q:Q1 D EHDR
....Q
...Q
..I 'Q1,$Y>22 D CR Q:Q1 D EHDR
..Q
.S TOT=+$G(^XTMP("BLRUCUM","ERR",ETYP))
.W !!,?3,TOT," ",HDR
.I $O(^XTMP("BLRUCUM","ERR",ETYP))="" W !!,$$CJ^XLFSTR("*** END OF REPORT ***",IOM) Q
.D CR Q:Q1
.Q
;
Q
;
EHDR ; Print Header for Error Report
S (HDR,UNL)=""
W !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- EXCEPTIONS REPORT",IOM)
I ETYP="NSPEC" S HDR="TESTS WITHOUT SPECIMENS - SKIPPED"
I ETYP="NUNIT" S HDR="SPECIMENS WITHOUT UNITS - SKIPPED"
I ETYP="NUCUM" S HDR="UNITS NOT LINKED TO UCUM"
I ETYP="PANEL" S HDR="PANELS - SKIPPED"
W !,$$CJ^XLFSTR(HDR,IOM)
W !,$$CJ^XLFSTR("================================================",IOM)
W !!,?3,"IEN",?15,"TEST (CATEGORY)" W:ETYP="NUNIT"!(ETYP="NUCUM") ?45,"SPECIMEN" W:ETYP="NUCUM" ?60,"UNITS"
W !,"--------------------------------------------------------------------------------"
Q
;
;Trim Leading Spaces
TRIMLSPC(X) ;
F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
Q X
;--------------------------------------------------------------------
;Trim Trailing Spaces
TRIMTSPC(X) ;
F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
Q X
;--------------------------------------------------------------------
;
;Trim All Leading and Trailing Spaces
TRIMALL(X) ;
Q $$TRIMLSPC($$TRIMTSPC(X))
;
;============================================================================================
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
+2 ;
+3 ; This routine goes through the LABORATORY TESTS file (#60) and verifies that the contents of the units field under the
+4 ; site/specimen sub-field can be linked to a valid UCUM entry found in a new IHS UCUM file (#90475.3).
+5 ;
+6 ; When completed, a summary report displays the outcome of the verification process and the user is prompted to request
+7 ; a detailed report of units verified based on either tests or units.
+8 ;
+9 ; Temporary globals for exceptions report:
+10 ; ^XTMP("BLRUCUM","ERR","PANEL") -- Panels without specimens and units
+11 ; ^XTMP("BLRUCUM","ERR","NSPEC") -- No specimen found, skipped
+12 ; ^XTMP("BLRUCUM","ERR","NUNIT") -- No units found, skipped
+13 ; ^XTMP("BLRUCUM","ERR","NUCUM") -- No UCUM equivalent found
+14 ;
+15 ; Temporary globals for results reports:
+16 ; ^XTMP("BLRUCUM","LOG")=CNT^SPEC, Total numbers of tests and specimens in File 60
+17 ; ^XTMP("BLRUCUM","LOG","TEST")=TCNT, # of tests that had units verified
+18 ; ^XTMP("BLRUCUM","LOG","TEST",test,specimen)=units
+19 ; ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT, total # of units verified
+20 ; ^XTMP("BLRUCUM","LOG","UNITS",units,UCUM)= # of instances verified for this unit
+21 ;
+22 ; Local Variables
+23 ; ---------------
+24 ; CNT - # of tests in File 60
+25 ; DONE - Flag = $H completed or 0 if not completed
+26 ; ETYP - Exceptions type, branch of ERR global: NSPEC, NUNIT or NUCUM
+27 ; NAME - Test name
+28 ; NCNT - # of specimens without units (ETYP=NUNIT)
+29 ; OKCNT - # of units verified and tied to UCUM
+30 ; RES - Prompt response
+31 ; SIEN - Specimen IEN in File 60
+32 ; SCNT - # of tests without specimens (ETYP=NSPEC)
+33 ; SPEC - # of specimens in File 60
+34 ; SPNM - Specimen description from File 61
+35 ; SWU - Specimens with units
+36 ; TCNT - Total number of tests with units verified
+37 ; TIEN - Test IEN in File 60
+38 ; UCNT - # of units with no UCUM equivalent (ETYP=NUCUM)
+39 ; UNITS - Units stored in each site/specimen node
+40 ; UCUM - UCUM formatted units tied to UID in File 90475.3
+41 ; UID - IEN of UCUM code in File 90475.3
+42 ; ZCNT - # of inactive tests skipped
+43 ; ===============================================================================================
+44 ;
+45 ; Initialize variables
+46 DO INIT
+47 ;
+48 ; Print header
+49 DO HDR
+50 ;
+51 ; Display message if conversion has already been run
+52 IF DONE
DO CMP
+53 ;
+54 ; Prompt for detailed results, if present
+55 IF $DATA(^XTMP("BLRUCUM","LOG"))
Begin DoDot:1
+56 IF DONE
WRITE !!,"RESULTS OF UNIT VERIFICATION ARE AVAILABLE"
+57 WRITE !!,"Display Detailed Results by Test, Units or Both? (T/U/B): "
READ RES:30
+58 IF RES="T"
DO TRPT
IF RES="U"
DO URPT
IF RES="B"
DO TRPT
DO URPT
+59 QUIT
End DoDot:1
+60 ;
+61 SET DIR(0)="Y"
SET DIR("A")="Verify Units Linked to UCUM"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+62 IF 'Y
QUIT
+63 ;
+64 ; Reset global and reinitialize variables for verification
+65 KILL ^XTMP("BLRUCUM")
+66 DO INIT
+67 ;
+68 SET TIEN=0
FOR
SET TIEN=$ORDER(^LAB(60,TIEN))
IF TIEN'=+TIEN
QUIT
SET CNT=CNT+1
WRITE "."
Begin DoDot:1
+69 SET NAME=$PIECE(^LAB(60,TIEN,0),U,1)
IF $EXTRACT(NAME,1,2)="ZZ"!($EXTRACT(NAME,1,2)="zz")
SET ZCNT=ZCNT+1
QUIT
+70 IF $ORDER(^LAB(60,TIEN,2,0))
SET ETYP="PANEL"
DO ERR
QUIT
+71 IF $ORDER(^LAB(60,TIEN,1,0))=""
SET ETYP="NSPEC"
DO ERR
QUIT
+72 SET SIEN=0
FOR
SET SIEN=$ORDER(^LAB(60,TIEN,1,SIEN))
IF SIEN'=+SIEN
QUIT
Begin DoDot:2
+73 SET SPEC=SPEC+1
+74 SET UNITS=$PIECE(^LAB(60,TIEN,1,SIEN,0),U,7)
SET UNITS=$TRANSLATE(UNITS,QT,"")
SET UNITS=$$TRIMALL(UNITS)
+75 IF UNITS=""
SET ETYP="NUNIT"
DO ERR
QUIT
+76 IF '$DATA(^BLRUCUM("B",UNITS))&('$DATA(^BLRUCUM("D",UNITS)))
SET ETYP="NUCUM"
DO ERR
QUIT
+77 SET UID=$SELECT($DATA(^BLRUCUM("B",UNITS)):$ORDER(^BLRUCUM("B",UNITS,"")),$DATA(^BLRUCUM("D",UNITS)):$ORDER(^BLRUCUM("D",UNITS,"")),1:"")
+78 IF UID=""
QUIT
+79 SET UCUM=$PIECE(^BLRUCUM(UID,0),U,1)
DO LOG
+80 QUIT
End DoDot:2
+81 QUIT
End DoDot:1
+82 ; Print completion message
+83 WRITE !!,"Verification of Units Linked to UCUM Completed"
+84 SET ^XTMP("BLRUCUM","LOG")=CNT_U_SPEC
+85 SET ^XTMP("BLRUCUM","LOG","INACT")=ZCNT
+86 SET ^XTMP("BLRUCUM","LOG","TEST")=TCNT
+87 SET ^XTMP("BLRUCUM","LOG","UNITS")=OKCNT
+88 SET ^XTMP("BLRUCUM","DONE")=$HOROLOG
+89 ;
+90 ; Print summary report
+91 DO SRPT
+92 ;
+93 ; Prompt for detailed results report
+94 IF $DATA(^XTMP("BLRUCUM","LOG"))
Begin DoDot:1
+95 WRITE !!,"Display Detailed Results for File 60 by Test, Units or Both? (T/U/B): "
READ RES:30
+96 IF RES="T"
DO TRPT
IF RES="U"
DO URPT
IF RES="B"
DO TRPT
DO URPT
+97 QUIT
End DoDot:1
+98 ;
+99 IF $DATA(^XTMP("BLRUCUM","ERR"))
Begin DoDot:1
+100 WRITE !!,"Print Exceptions Report? (Y/<N>): "
READ RES:30
SET RES=$SELECT(RES="Y":1,1:0)
+101 IF RES
DO ERPT
+102 QUIT
End DoDot:1
+103 QUIT
+104 ;
INIT ; Clear the screen and initialize variables
+1 DO ^XBCLS
+2 SET U1=":"
SET U2=";"
SET CM=","
SET QT=""""
+3 SET (CNT,DRPT,OKCNT,PCNT,RES,TCNT,TIEN,SIEN,SPEC,Q,Q1,ZCNT)=0
+4 SET (ETYP,HDR,NAME,SPNM,UCUM,UID,UNITS,UNL)=""
+5 SET TODAY=$$HTFM^XLFDT($HOROLOG,1)
+6 SET PURGE=$$HTFM^XLFDT($PIECE($HOROLOG,CM,1)+90,1)
+7 IF '$DATA(^XTMP("BLRUCUM"))
SET ^XTMP("BLRUCUM",0)=PURGE_U_TODAY_U_"UCUM VERIFICATION"
+8 SET DONE=+$GET(^XTMP("BLRUCUM","DONE"))
+9 QUIT
+10 ;
HDR ; Print header
+1 SET HDR="VERIFY FILE 60 UNITS LINKED TO UCUM"
+2 SET UNL="==================================="
+3 WRITE !!,$$CJ^XLFSTR(HDR,IOM)
+4 WRITE !,$$CJ^XLFSTR(UNL,IOM)
+5 QUIT
+6 ;
CMP ; Verification completed display
+1 SET CHDR="Verification of Units Linked to UCUM completed on "_$$HTE^XLFDT(DONE)
+2 DO ^XBON
+3 WRITE !!,$$CJ^XLFSTR(CHDR,IOM)
+4 DO ^XBOFF
+5 QUIT
+6 ;
CR ;
+1 SET Q1=0
+2 WRITE !,"Enter RETURN to continue or '^' to exit:"
READ RES:30
+3 IF RES="^"
SET Q1=1
QUIT
+4 IF RES=""
SET $Y=0
QUIT
+5 DO CR
+6 QUIT
+7 ;
ERR ; Log exceptions for File 60 verification
+1 IF ETYP="NSPEC"!(ETYP="PANEL")
SET ^XTMP("BLRUCUM","ERR",ETYP,TIEN)=""
+2 IF ETYP="NUNIT"!(ETYP="NUCUM")
SET ^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN)=$GET(UNITS)
+3 SET ^XTMP("BLRUCUM","ERR",ETYP)=+$GET(^XTMP("BLRUCUM","ERR",ETYP))+1
+4 QUIT
+5 ;
LOG ; Log tests with units verified, by test,specimen and by units,UCUM
+1 IF '$DATA(^XTMP("BLRUCUM","LOG","TEST",TIEN))
SET TCNT=TCNT+1
SET ^XTMP("BLRUCUM","LOG","TEST")=TCNT
+2 IF '$DATA(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN))
SET OKCNT=OKCNT+1
+3 SET ^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)=$GET(UNITS)_U_$GET(UCUM)
+4 SET ^XTMP("BLRUCUM","LOG","UNITS")=+$GET(^XTMP("BLRUCUM","LOG","UNITS"))+1
+5 SET ^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM)=+$GET(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))+1
+6 QUIT
+7 ;
SRPT ; Summary Report
+1 DO ^XBCLS
+2 SET PCNT=+$GET(^XTMP("BLRUCUM","ERR","PANEL"))
+3 SET SCNT=+$GET(^XTMP("BLRUCUM","ERR","NSPEC"))
+4 SET NCNT=+$GET(^XTMP("BLRUCUM","ERR","NUNIT"))
+5 SET UCNT=+$GET(^XTMP("BLRUCUM","ERR","NUCUM"))
+6 SET ZCNT=+$GET(^XTMP("BLRUCUM","LOG","INACT"))
+7 IF $GET(^XTMP("BLRUCUM","LOG"))'=""
SET CNT=+$PIECE(^XTMP("BLRUCUM","LOG"),U,1)
SET SPEC=+$PIECE(^XTMP("BLRUCUM","LOG"),U,2)
+8 SET OKCNT=+$GET(^XTMP("BLRUCUM","LOG","UNITS"))
+9 SET SWU=+$GET(SPEC)-(+$GET(NCNT))
+10 WRITE !,$$CJ^XLFSTR("UNITS LINKED TO UCUM - RESULTS SUMMARY",IOM)
+11 WRITE !,$$CJ^XLFSTR("======================================",IOM)
+12 ;
+13 WRITE !!,$JUSTIFY(CNT,5),?7,"TESTS and ",SPEC," SPECIMENS examined in File 60"
+14 WRITE !,$JUSTIFY(OKCNT,5),?7
IF SWU>0
WRITE "(",$EXTRACT((OKCNT/SWU*100),1,5),"%)"
WRITE " UNITS linked to UCUM"
+15 ;
+16 ; Print error summary
+17 WRITE !!,$$CJ^XLFSTR("Summary of Exceptions",IOM)
+18 WRITE !,$$CJ^XLFSTR("---------------------",IOM)
+19 WRITE !,$JUSTIFY(ZCNT,5),?7
IF CNT>0
WRITE "(",$EXTRACT((ZCNT/CNT*100),1,5),"%)"
WRITE " INACTIVE TESTS skipped"
+20 WRITE !,$JUSTIFY(PCNT,5),?7
IF CNT>0
WRITE "(",$EXTRACT((PCNT/CNT*100),1,5),"%)"
WRITE " PANELS skipped"
+21 WRITE !,$JUSTIFY(SCNT,5),?7
IF CNT>0
WRITE "(",$EXTRACT((SCNT/CNT*100),1,5),"%)"
WRITE " TESTS w/o specimens skipped"
+22 WRITE !,$JUSTIFY(NCNT,5),?7
IF SPEC>0
WRITE "(",$EXTRACT((NCNT/SPEC*100),1,5),"%)"
WRITE " SPECIMENS w/o units skipped"
+23 WRITE !,$JUSTIFY(UCNT,5),?7
IF OKCNT>0
WRITE "(",$EXTRACT((UCNT/(UCNT+OKCNT)*100),1,5),"%)"
WRITE " UNITS not linked to UCUM"
+24 QUIT
TRPT ; Display detailed results by test
+1 SET DONE=+$GET(^XTMP("BLRUCUM","DONE"))
+2 SET TCNT=+$GET(^XTMP("BLRUCUM","LOG","TEST"))
+3 DO ^XBCLS
+4 DO THDR
+5 SET TIEN=""
SET Q1=0
+6 FOR
SET TIEN=$ORDER(^XTMP("BLRUCUM","LOG","TEST",TIEN))
IF Q1!(TIEN="")
QUIT
Begin DoDot:1
+7 SET SIEN=""
FOR
SET SIEN=$ORDER(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN))
IF Q1!(SIEN="")
QUIT
Begin DoDot:2
+8 SET TST=$PIECE(^LAB(60,TIEN,0),U,1)
+9 SET SPNM=$PIECE(^LAB(61,SIEN,0),U,1)
+10 SET UNITS=$PIECE($GET(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,1)
+11 SET UCUM=$PIECE($GET(^XTMP("BLRUCUM","LOG","TEST",TIEN,SIEN)),U,2)
+12 WRITE !,?3,TIEN,?10,$EXTRACT(TST,1,23),?35,$EXTRACT(SPNM,1,13),?50,UNITS,?65,UCUM
+13 IF $Y>22
DO CR
IF Q1
QUIT
DO THDR
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 WRITE !!,?3,TCNT," Tests with Units Linked to UCUM"
+17 DO CR
IF Q1
QUIT
+18 QUIT
+19 ;
URPT ; Print detailed results by units
+1 SET UCNT=+$GET(^XTMP("BLRUCUM","LOG","UNITS"))
+2 DO ^XBCLS
+3 DO UHDR
+4 SET UNITS=""
SET Q1=0
+5 FOR
SET UNITS=$ORDER(^XTMP("BLRUCUM","LOG","UNITS",UNITS))
IF UNITS=""!(Q1)
QUIT
Begin DoDot:1
+6 SET UCUM=$ORDER(^XTMP("BLRUCUM","LOG","UNITS",UNITS,""))
IF UCUM=""
QUIT
+7 SET UID=$ORDER(^BLRUCUM("B",UCUM,""))
+8 SET CNT=+$GET(^XTMP("BLRUCUM","LOG","UNITS",UNITS,UCUM))
+9 WRITE !,?25,CNT,?32,"'"_UNITS_"'",?50,UCUM
+10 IF $Y>22
DO CR
IF Q1
QUIT
DO UHDR
+11 QUIT
End DoDot:1
+12 WRITE !!,?3,UCNT," Units Linked to UCUM"
+13 DO CR
IF Q1
QUIT
+14 QUIT
+15 ;
THDR ; Print Header for File 60 Test Report
+1 WRITE !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY TEST",IOM)
+2 WRITE !,$$CJ^XLFSTR("===============================================",IOM)
+3 WRITE !!,?3,"IEN",?10,"TEST",?35,"SPECIMEN",?50,"UNITS",?65,"UCUM"
+4 WRITE !,"--------------------------------------------------------------------------------"
+5 QUIT
+6 ;
UHDR ; Print Header for File 60 Units Report
+1 WRITE !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- RESULTS BY UNITS",IOM)
+2 WRITE !,$$CJ^XLFSTR("================================================",IOM)
+3 WRITE !!,?24,"Instances of Units Linked to UCUM"
+4 WRITE !,?24,"----------------------------------"
+5 QUIT
+6 ;
ERPT ; Print Detailed Exceptions Report
+1 IF '$DATA(^XTMP("BLRUCUM","ERR"))
WRITE !!,$$CJ^XLFSTR("NO EXCEPTIONS TO REPORT",IOM)
HANG 2
QUIT
+2 ;
+3 ; Print exceptions from File 60
+4 SET ETYP="A"
SET Q1=0
+5 FOR
SET ETYP=$ORDER(^XTMP("BLRUCUM","ERR",ETYP))
IF Q1!(ETYP="")
QUIT
Begin DoDot:1
+6 DO ^XBCLS
+7 DO EHDR
+8 SET TIEN=""
SET Q1=0
+9 FOR
SET TIEN=$ORDER(^XTMP("BLRUCUM","ERR",ETYP,TIEN))
IF Q1!(TIEN="")
QUIT
Begin DoDot:2
+10 SET TST=$PIECE(^LAB(60,TIEN,0),U,1)
SET SS=$PIECE(^LAB(60,TIEN,0),U,4)
+11 IF $ORDER(^LAB(60,TIEN,2,0))
SET TST=TST_" (PANEL)"
+12 WRITE !,?3,TIEN,?15,$EXTRACT(TST,1,23)_$SELECT(SS'="":" ("_SS_")",1:"")
+13 IF ETYP="NUNIT"!(ETYP="NUCUM")
SET SIEN=""
SET LN=1
Begin DoDot:3
+14 FOR
SET SIEN=$ORDER(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN))
IF Q1!(SIEN="")
QUIT
Begin DoDot:4
+15 SET SPNM=$PIECE(^LAB(61,SIEN,0),U,1)
SET UNITS=$GET(^XTMP("BLRUCUM","ERR",ETYP,TIEN,SIEN))
+16 IF LN>1
WRITE !
WRITE ?45,$EXTRACT(SPNM,1,12)
IF ETYP="NUCUM"
WRITE ?60,$GET(UNITS)
SET LN=LN+1
+17 IF $Y>22
DO CR
IF Q1
QUIT
DO EHDR
+18 QUIT
End DoDot:4
+19 QUIT
End DoDot:3
+20 IF 'Q1
IF $Y>22
DO CR
IF Q1
QUIT
DO EHDR
+21 QUIT
End DoDot:2
+22 SET TOT=+$GET(^XTMP("BLRUCUM","ERR",ETYP))
+23 WRITE !!,?3,TOT," ",HDR
+24 IF $ORDER(^XTMP("BLRUCUM","ERR",ETYP))=""
WRITE !!,$$CJ^XLFSTR("*** END OF REPORT ***",IOM)
QUIT
+25 DO CR
IF Q1
QUIT
+26 QUIT
End DoDot:1
+27 ;
+28 QUIT
+29 ;
EHDR ; Print Header for Error Report
+1 SET (HDR,UNL)=""
+2 WRITE !,$$CJ^XLFSTR("FILE 60 UNITS LINKED TO UCUM -- EXCEPTIONS REPORT",IOM)
+3 IF ETYP="NSPEC"
SET HDR="TESTS WITHOUT SPECIMENS - SKIPPED"
+4 IF ETYP="NUNIT"
SET HDR="SPECIMENS WITHOUT UNITS - SKIPPED"
+5 IF ETYP="NUCUM"
SET HDR="UNITS NOT LINKED TO UCUM"
+6 IF ETYP="PANEL"
SET HDR="PANELS - SKIPPED"
+7 WRITE !,$$CJ^XLFSTR(HDR,IOM)
+8 WRITE !,$$CJ^XLFSTR("================================================",IOM)
+9 WRITE !!,?3,"IEN",?15,"TEST (CATEGORY)"
IF ETYP="NUNIT"!(ETYP="NUCUM")
WRITE ?45,"SPECIMEN"
IF ETYP="NUCUM"
WRITE ?60,"UNITS"
+10 WRITE !,"--------------------------------------------------------------------------------"
+11 QUIT
+12 ;
+13 ;Trim Leading Spaces
TRIMLSPC(X) ;
+1 FOR
IF $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 QUIT X
+3 ;--------------------------------------------------------------------
+4 ;Trim Trailing Spaces
TRIMTSPC(X) ;
+1 FOR
IF $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT X
+3 ;--------------------------------------------------------------------
+4 ;
+5 ;Trim All Leading and Trailing Spaces
TRIMALL(X) ;
+1 QUIT $$TRIMLSPC($$TRIMTSPC(X))
+2 ;
+3 ;============================================================================================
