VBECDCR ;hoifo/gjc-data conversion & pre-implementation reporting mechanism;Nov 21, 2002
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
;Medical Device #:
;Note: The food and Drug Administration classifies this software as a
;medical device. As such, it may not be changed in any way.
;Modifications to this software may result in an adulterated medical
;device under 21CFR820, the use of which is considered to be a
;violation of US Federal Statutes. Acquiring and implementing this
;software through the Freedom of Information Act requires the
;implementer to assume total responsibility for the software, and
;become a registered manufacturer of a medical device, subject to FDA
;regulations.
;
;Call to $$NEWERR^%ZTER is supported by IA: 1621
;Call to $$S^%ZTLOAD is supported by IA: 10063
;Call to FILE^DID is supported by IA: 2052
;Call to $$EXTERNAL^DILFD is supported by IA: 2055
;Call to ^DIR is supported by IA: 10026
;Call to ^DIWP is supported by IA: 10011
;Call to $$DT^XLFDT is supported by IA: 10103
;Call to $$FMTE^XLFDT is supported by IA: 10103
;Call to $$CJ^XLFSTR is supported by IA: 10104
;Call to EN^XUTMDEVQ is supported by IA: 1519
;global read on ^DPT(DFN,0) for patient name supported by IA: 10035
;Execution of ^%ZOSF("TEST") is supported by IA: 10096
;
EN ; entry point for anomaly report
;
I $S($D(DUZ)[0:1,$D(DUZ(0))[0:1,'DUZ:1,DUZ=.5:1,1:0) W !!?3,$C(7),"DUZ & DUZ(0) must be defined to an active user (not POSTMASTER) in order to",!?3,"proceed." Q
;
; initialize the error trap
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^VBECDCU1"
E S X="D ERR^VBECDCU1",@^%ZOSF("TRAP")
;
; check to see if anomaly data exists for the most recent record in the
; VBECS DATA INTEGRITY/CONVERSION STATISTICS (#6001) file.
S VBECIEN=$O(^VBEC(6001,$C(32)),-1)
I '$O(^VBEC(6001,VBECIEN,"ERR",0)) D Q
.K VBECIEN
.W !!?3,"There are no occurrences of VistA Blood Bank data anomalies on file to be",!?3,"displayed.",$C(7)
.Q
;
S VBECR="START^VBECDCR",VBECS("DUZ")="",VBECS("VBECIEN")=""
S VBECZ="MQ",VBECD="VBECS data anomaly reporting process"
D EN^XUTMDEVQ(VBECR,VBECD,.VBECS,,1)
I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
K VBECIEN,VBECD,VBECR,VBECS,VBECZ,ZTSK
Q
;
START ; display the data
;
; VBEC(1)=process start timestamp (internal)
; VBEC(2)=process (internal)
; VBEC(3)=process finish timestamp (internal)
; VBEC(4)=user responsible for process (internal)
; VBECX(1)=process start timestamp (external)
; VBECX(2)=process (external)
; VBECX(3)=process finish timestamp (external)
; VBECX(4)=user responsible for process (external)
; VBEC1A(1)=file navigated (pointer)
; VBEC1A(2)=ien of record in file navigated
; VBEC1A(3)=file navigate to (pointer)
; VBEC1A(4)=ien of record in file navigated to
; VBEC1A(5)=lrdfn1 dup blood component/blood component id (same patient)
; VBEC1A(6)=lrdfn2 dup blood component/blood component id (diff patients)
; VBEC1A(7)=blood component (pointer)
; VBEC1A(8)=blood component id
; VBEC1A(9)=user readable data integrity issue
;
S:$D(ZTQUEUED) ZTREQ="@" S PAGE=1,(VBEC1,VBECXIT,VBECSTOP)=0,U="^"
S $P(LINE,"*",81)="",TODAY=$$FMTE^XLFDT($$DT^XLFDT(),1)
S VBEC(0)=$G(^VBEC(6001,VBECIEN,0))
F I=1:1:4 S VBEC(I)=$P(VBEC(0),U,I) ;internal
F I=1:1:4 S VBECX(I)=$$EXTERNAL^DILFD(6001,".0"_I,"L",VBEC(I)) ;external
D HDR ; header output
F S VBEC1=$O(^VBEC(6001,VBECIEN,"ERR",VBEC1)) Q:'VBEC1 D Q:VBECXIT!(VBECSTOP)
.I $$S^%ZTLOAD() S (ZTSTOP,VBECSTOP)=1 Q
.S VBECERR(0)=$G(^VBEC(6001,VBECIEN,"ERR",VBEC1,0))
.F I=1:1:9 S VBEC1A(I)=$P(VBECERR(0),U,I)
.S ERRTOT(VBEC1A(1))=+$G(ERRTOT(VBEC1A(1)))+1
.D FILE^DID(VBEC1A(1),"","NAME","VBECFR")
.D:VBEC1A(3) FILE^DID(VBEC1A(3),"","NAME","VBECTO")
.S VBECOMP=$$EXTERNAL^DILFD(6001.01,.07,"L",VBEC1A(7)) ; value or null
.S X=VBEC1A(9),DIWL=1,DIWR=55,DIWF="" D ^DIWP ; format text...
.W !,"File Navigated: "_VBECFR("NAME")_"("_VBEC1A(1)_")"
.I $Y>(IOSL-4) D EOS Q:VBECXIT
.W:VBEC1A(2) !,$$NAME(VBEC1A(1),VBEC1A(2))
.W:VBEC1A(3) !,"File Navigated To: "_VBECTO("NAME")_"("_VBEC1A(3)_")"
.I $Y>(IOSL-4) D EOS Q:VBECXIT
.W:VBEC1A(4) !,$$NAME(VBEC1A(3),VBEC1A(4))
.W:VBEC1A(5) !,"Similar Blood Component/Blood Component ID for Lab Data patient"
.W $S((VBEC1A(5)&VBEC1A(6)):"s:",(VBEC1A(5)&'VBEC1A(6)):":",1:"")
.I $Y>(IOSL-4) D EOS Q:VBECXIT
.W:VBEC1A(5) !?3,"LRDFN (IEN in Lab Data file): "_VBEC1A(5)
.W:VBEC1A(6) !?3,"LRDFN (conflicting patient IEN): "_VBEC1A(6)
.I $Y>(IOSL-4) D EOS Q:VBECXIT
.W:VBEC1A(7) !,"Blood Component: "_VBECOMP
.W:VBEC1A(8)'="" !,"Blood Component ID: "_VBEC1A(8)
.I $Y>(IOSL-4) D EOS Q:VBECXIT
.W !,"Data Integrity Issue: " S A=0
.I $Y>(IOSL-4) D EOS Q:VBECXIT W !
.F S A=$O(^UTILITY($J,"W",DIWL,A)) Q:'A!(VBECXIT) D
..I $Y>(IOSL-4) D EOS Q:VBECXIT W !
..W ?22,$G(^UTILITY($J,"W",DIWL,A,0)),!
..Q
.K A,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,VBEC1A,VBECFR,VBECOMP,VBECTO,X,Z,^UTILITY($J,"W")
.Q
;
ERRTOT ; print error total for each file
I $Y>(IOSL-6) D EOS Q:VBECXIT W !
S I=0 F S I=$O(ERRTOT(I)) Q:'I W !,"Total number of anomalies for file "_I_": "_$G(ERRTOT(I))
;
XIT ; cleanup after yourself before you go...
K A,DIRUT,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,DTOUT,DUOUT,ERRTOT,I,LINE,PAGE,TODAY,VBEC,VBEC1,VBEC1A,VBECERR,VBECFR,VBECOMP,VBECTO,VBECX,VBECXIT,X,Z,^UTILITY($J,"W"),VBECSTOP
Q
;
EOS ; end of screen check & refresh screen action
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S VBECXIT=$S(Y'>0:1,1:0) K DIR,X,Y
Q:VBECXIT
HDR ; draw header
W:($E(IOST)="C")!(PAGE>1) @IOF
W !,$$CJ^XLFSTR("VistA Blood Bank Data Anomalies Report",80)
W !,"Date: ",TODAY,?69,"Page: ",PAGE S PAGE=PAGE+1
W !,"Process initiated by: "_$E(VBECX(4),1,25),?49,"Process: "_VBECX(2)
W !,"Start time: "_VBECX(1),?49,"Finish time: "_VBECX(3),!,LINE
Q
;
NAME(FILE,IEN) ; Using file number and ien, determine the value of the .01
; field and pass it back (along with the data descriptor).
; input: FILE-file number, either 2, 63, 65, or 66
; IEN-internal entry number of the record in question
; output: (examples) Patient Name: Doe,John, Lab Data ID: 12345,
; Unit ID: ABC123, Blood Component: CPDA-1 RED BLOOD CELLS
;
Q:FILE=2 "Patient Name: "_$P($G(^DPT(IEN,0)),U)_$S($P($G(^DPT(IEN,0)),U)]"":" ("_$E($P($G(^DPT(IEN,0)),U,9),1,3)_"-"_$E($P($G(^DPT(IEN,0)),U,9),4,5)_"-"_$E($P($G(^DPT(IEN,0)),U,9),6,9)_")",1:"")
Q:FILE=63 "Lab Data ID: "_$P($G(^LR(IEN,0)),U)
Q:FILE=65 "Unit ID: "_$P($G(^LRD(65,IEN,0)),U)
Q:FILE=66 "Blood Component: "_$P($G(^LAB(66,IEN,0)),U)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDCR 6649 printed Dec 13, 2024@02:44:06 Page 2
VBECDCR ;hoifo/gjc-data conversion & pre-implementation reporting mechanism;Nov 21, 2002
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ;Medical Device #:
+4 ;Note: The food and Drug Administration classifies this software as a
+5 ;medical device. As such, it may not be changed in any way.
+6 ;Modifications to this software may result in an adulterated medical
+7 ;device under 21CFR820, the use of which is considered to be a
+8 ;violation of US Federal Statutes. Acquiring and implementing this
+9 ;software through the Freedom of Information Act requires the
+10 ;implementer to assume total responsibility for the software, and
+11 ;become a registered manufacturer of a medical device, subject to FDA
+12 ;regulations.
+13 ;
+14 ;Call to $$NEWERR^%ZTER is supported by IA: 1621
+15 ;Call to $$S^%ZTLOAD is supported by IA: 10063
+16 ;Call to FILE^DID is supported by IA: 2052
+17 ;Call to $$EXTERNAL^DILFD is supported by IA: 2055
+18 ;Call to ^DIR is supported by IA: 10026
+19 ;Call to ^DIWP is supported by IA: 10011
+20 ;Call to $$DT^XLFDT is supported by IA: 10103
+21 ;Call to $$FMTE^XLFDT is supported by IA: 10103
+22 ;Call to $$CJ^XLFSTR is supported by IA: 10104
+23 ;Call to EN^XUTMDEVQ is supported by IA: 1519
+24 ;global read on ^DPT(DFN,0) for patient name supported by IA: 10035
+25 ;Execution of ^%ZOSF("TEST") is supported by IA: 10096
+26 ;
EN ; entry point for anomaly report
+1 ;
+2 IF $SELECT($DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,'DUZ:1,DUZ=.5:1,1:0)
WRITE !!?3,$CHAR(7),"DUZ & DUZ(0) must be defined to an active user (not POSTMASTER) in order to",!?3,"proceed."
QUIT
+3 ;
+4 ; initialize the error trap
+5 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^VBECDCU1"
+6 IF '$TEST
SET X="D ERR^VBECDCU1"
SET @^%ZOSF("TRAP")
+7 ;
+8 ; check to see if anomaly data exists for the most recent record in the
+9 ; VBECS DATA INTEGRITY/CONVERSION STATISTICS (#6001) file.
+10 SET VBECIEN=$ORDER(^VBEC(6001,$CHAR(32)),-1)
+11 IF '$ORDER(^VBEC(6001,VBECIEN,"ERR",0))
Begin DoDot:1
+12 KILL VBECIEN
+13 WRITE !!?3,"There are no occurrences of VistA Blood Bank data anomalies on file to be",!?3,"displayed.",$CHAR(7)
+14 QUIT
End DoDot:1
QUIT
+15 ;
+16 SET VBECR="START^VBECDCR"
SET VBECS("DUZ")=""
SET VBECS("VBECIEN")=""
+17 SET VBECZ="MQ"
SET VBECD="VBECS data anomaly reporting process"
+18 DO EN^XUTMDEVQ(VBECR,VBECD,.VBECS,,1)
+19 IF +$GET(ZTSK)>0
WRITE !!,"Task Number: "_ZTSK,!
+20 KILL VBECIEN,VBECD,VBECR,VBECS,VBECZ,ZTSK
+21 QUIT
+22 ;
START ; display the data
+1 ;
+2 ; VBEC(1)=process start timestamp (internal)
+3 ; VBEC(2)=process (internal)
+4 ; VBEC(3)=process finish timestamp (internal)
+5 ; VBEC(4)=user responsible for process (internal)
+6 ; VBECX(1)=process start timestamp (external)
+7 ; VBECX(2)=process (external)
+8 ; VBECX(3)=process finish timestamp (external)
+9 ; VBECX(4)=user responsible for process (external)
+10 ; VBEC1A(1)=file navigated (pointer)
+11 ; VBEC1A(2)=ien of record in file navigated
+12 ; VBEC1A(3)=file navigate to (pointer)
+13 ; VBEC1A(4)=ien of record in file navigated to
+14 ; VBEC1A(5)=lrdfn1 dup blood component/blood component id (same patient)
+15 ; VBEC1A(6)=lrdfn2 dup blood component/blood component id (diff patients)
+16 ; VBEC1A(7)=blood component (pointer)
+17 ; VBEC1A(8)=blood component id
+18 ; VBEC1A(9)=user readable data integrity issue
+19 ;
+20 if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET PAGE=1
SET (VBEC1,VBECXIT,VBECSTOP)=0
SET U="^"
+21 SET $PIECE(LINE,"*",81)=""
SET TODAY=$$FMTE^XLFDT($$DT^XLFDT(),1)
+22 SET VBEC(0)=$GET(^VBEC(6001,VBECIEN,0))
+23 ;internal
FOR I=1:1:4
SET VBEC(I)=$PIECE(VBEC(0),U,I)
+24 ;external
FOR I=1:1:4
SET VBECX(I)=$$EXTERNAL^DILFD(6001,".0"_I,"L",VBEC(I))
+25 ; header output
DO HDR
+26 FOR
SET VBEC1=$ORDER(^VBEC(6001,VBECIEN,"ERR",VBEC1))
if 'VBEC1
QUIT
Begin DoDot:1
+27 IF $$S^%ZTLOAD()
SET (ZTSTOP,VBECSTOP)=1
QUIT
+28 SET VBECERR(0)=$GET(^VBEC(6001,VBECIEN,"ERR",VBEC1,0))
+29 FOR I=1:1:9
SET VBEC1A(I)=$PIECE(VBECERR(0),U,I)
+30 SET ERRTOT(VBEC1A(1))=+$GET(ERRTOT(VBEC1A(1)))+1
+31 DO FILE^DID(VBEC1A(1),"","NAME","VBECFR")
+32 if VBEC1A(3)
DO FILE^DID(VBEC1A(3),"","NAME","VBECTO")
+33 ; value or null
SET VBECOMP=$$EXTERNAL^DILFD(6001.01,.07,"L",VBEC1A(7))
+34 ; format text...
SET X=VBEC1A(9)
SET DIWL=1
SET DIWR=55
SET DIWF=""
DO ^DIWP
+35 WRITE !,"File Navigated: "_VBECFR("NAME")_"("_VBEC1A(1)_")"
+36 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+37 if VBEC1A(2)
WRITE !,$$NAME(VBEC1A(1),VBEC1A(2))
+38 if VBEC1A(3)
WRITE !,"File Navigated To: "_VBECTO("NAME")_"("_VBEC1A(3)_")"
+39 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+40 if VBEC1A(4)
WRITE !,$$NAME(VBEC1A(3),VBEC1A(4))
+41 if VBEC1A(5)
WRITE !,"Similar Blood Component/Blood Component ID for Lab Data patient"
+42 WRITE $SELECT((VBEC1A(5)&VBEC1A(6)):"s:",(VBEC1A(5)&'VBEC1A(6)):":",1:"")
+43 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+44 if VBEC1A(5)
WRITE !?3,"LRDFN (IEN in Lab Data file): "_VBEC1A(5)
+45 if VBEC1A(6)
WRITE !?3,"LRDFN (conflicting patient IEN): "_VBEC1A(6)
+46 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+47 if VBEC1A(7)
WRITE !,"Blood Component: "_VBECOMP
+48 if VBEC1A(8)'=""
WRITE !,"Blood Component ID: "_VBEC1A(8)
+49 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+50 WRITE !,"Data Integrity Issue: "
SET A=0
+51 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
WRITE !
+52 FOR
SET A=$ORDER(^UTILITY($JOB,"W",DIWL,A))
if 'A!(VBECXIT)
QUIT
Begin DoDot:2
+53 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
WRITE !
+54 WRITE ?22,$GET(^UTILITY($JOB,"W",DIWL,A,0)),!
+55 QUIT
End DoDot:2
+56 KILL A,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,VBEC1A,VBECFR,VBECOMP,VBECTO,X,Z,^UTILITY($JOB,"W")
+57 QUIT
End DoDot:1
if VBECXIT!(VBECSTOP)
QUIT
+58 ;
ERRTOT ; print error total for each file
+1 IF $Y>(IOSL-6)
DO EOS
if VBECXIT
QUIT
WRITE !
+2 SET I=0
FOR
SET I=$ORDER(ERRTOT(I))
if 'I
QUIT
WRITE !,"Total number of anomalies for file "_I_": "_$GET(ERRTOT(I))
+3 ;
XIT ; cleanup after yourself before you go...
+1 KILL A,DIRUT,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,DTOUT,DUOUT,ERRTOT,I,LINE,PAGE,TODAY,VBEC,VBEC1,VBEC1A,VBECERR,VBECFR,VBECOMP,VBECTO,VBECX,VBECXIT,X,Z,^UTILITY($JOB,"W"),VBECSTOP
+2 QUIT
+3 ;
EOS ; end of screen check & refresh screen action
+1 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET VBECXIT=$SELECT(Y'>0:1,1:0)
KILL DIR,X,Y
+2 if VBECXIT
QUIT
HDR ; draw header
+1 if ($EXTRACT(IOST)="C")!(PAGE>1)
WRITE @IOF
+2 WRITE !,$$CJ^XLFSTR("VistA Blood Bank Data Anomalies Report",80)
+3 WRITE !,"Date: ",TODAY,?69,"Page: ",PAGE
SET PAGE=PAGE+1
+4 WRITE !,"Process initiated by: "_$EXTRACT(VBECX(4),1,25),?49,"Process: "_VBECX(2)
+5 WRITE !,"Start time: "_VBECX(1),?49,"Finish time: "_VBECX(3),!,LINE
+6 QUIT
+7 ;
NAME(FILE,IEN) ; Using file number and ien, determine the value of the .01
+1 ; field and pass it back (along with the data descriptor).
+2 ; input: FILE-file number, either 2, 63, 65, or 66
+3 ; IEN-internal entry number of the record in question
+4 ; output: (examples) Patient Name: Doe,John, Lab Data ID: 12345,
+5 ; Unit ID: ABC123, Blood Component: CPDA-1 RED BLOOD CELLS
+6 ;
+7 if FILE=2
QUIT "Patient Name: "_$PIECE($GET(^DPT(IEN,0)),U)_$SELECT($PIECE($GET(^DPT(IEN,0)),U)]"":" ("_$EXTRACT($PIECE($GET(^DPT(IEN,0)),U,9),1,3)_"-"_$EXTRACT($PIECE($GET(^DPT(IEN,0)),U,9),4,5)_"-"_$EXTRACT($PIECE($GET(^DPT(IEN,0)),U,9),6,9)_")",1:
"")
+8 if FILE=63
QUIT "Lab Data ID: "_$PIECE($GET(^LR(IEN,0)),U)
+9 if FILE=65
QUIT "Unit ID: "_$PIECE($GET(^LRD(65,IEN,0)),U)
+10 if FILE=66
QUIT "Blood Component: "_$PIECE($GET(^LAB(66,IEN,0)),U)
+11 ;
