- 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 Jan 18, 2025@03:45:14 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 ;