VBECDCNM ;hoifo/gjc-print unmapped data from 61.3 or 65.4;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 $$EXTERNAL^DILFD is supported by IA: 2055
;Call to ^DIR is supported by IA: 10026
;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
;Execution of ^%ZOSF("TEST") is supported by IA: 10096
;
EN ; entry point for unmapped data report. this is an evocable entry point
; for the option: ???.
;
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
;
RPT6005 ; Select the unmapped VistA attribute you wish to examine.
;
; initialize the error trap code
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^VBECDCU1"
E S X="D ERR^VBECDCU1",@^%ZOSF("TRAP")
;
S VBECS=$$ATTR^VBECDCU1() ; select data attribute family
I VBECS="^" D EXIT Q
S VBECFILE=$P(VBECS,U),VBECATT=$P(VBECS,U,2)
;
K VBECS S VBECR="GO^VBECDCNM"
F I="DUZ","VBECFILE","VBECATT" S VBECS(I)=""
K I S VBECD="VBECS display currently unmapped VistA Blood bank data"
S VBECZ="MQ" D EN^XUTMDEVQ(VBECR,VBECD,.VBECS,,1)
I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
;
EXIT ;clean up the symbol table; exit the utility
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,VBECATT,VBECIEN,VBECD,VBECFILE,VBECR,VBECS,VBECZ,X,Y,ZTSK
Q
;
GO ; print unmapped data from file: 61.3 or 65.4
;
;Note: VBECFILE will either be 61.3 or 65.4
Q:'$G(VBECFILE) S:$D(ZTQUEUED) ZTREQ="@"
;
S PAGE=1,$P(LINE,"-",(IOM+1))="",TODAY=$$FMTE^XLFDT($$DT^XLFDT(),"1P")
D HDR S (VBECXIT,VBECSTOP)=0 S VBEC02=""
F S VBEC02=$O(^VBEC(6005,"N",VBEC02)) Q:VBEC02="" D Q:VBECXIT!(VBECSTOP)
.S VBECIEN=0
.F S VBECIEN=$O(^VBEC(6005,"N",VBEC02,VBECIEN)) Q:'VBECIEN D Q:VBECXIT!(VBECSTOP)
..S VBECY(0)=$G(^VBEC(6005,VBECIEN,0))
..Q:+$P(VBECY(0),U)'=VBECFILE ;sorting by file, printing by alpha
..Q:$P(VBECY(0),U,5)'="" ;GUID chk
..S VBECFIEN=$P(VBECY(0),U),VBECNAME=$P(VBECY(0),U,2)
..S VBECANTI=$$EXTERNAL^DILFD(6005,.04,,$P(VBECY(0),U,4))
..I $$S^%ZTLOAD() S (ZTSTOP,VBECSTOP)=1 Q
..;
..W !,VBECNAME W:VBECFILE=61.3 ?34,VBECANTI W:VBECFILE=66 ?44,$P(VBECY(0),U,3)
..I $Y>(IOSL-4) D EOS
..Q
.Q
;
W:$G(VBECFIEN)="" !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
K LINE,PAGE,POP,TODAY,VBEC02,VBECANTI,VBECFIEN,VBECIEN,VBECNAME,VBECXIT,VBECY,VBECSTOP
Q
;
EOS ; end of screen (eos) check & refresh screen action
; check to see if additional data, for this particular file,
; exists to print, if not exit w/o issuing the eos prompt.
;
Q:$O(^VBEC(6005,"B",VBECFIEN))=""
;
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 Data Not Mapped To Standard SQL Server Attributes",80)
W !,"Date: ",TODAY,?69,"Page: ",PAGE
W:VBECFILE=61.3 !,"Antigen/Antibody",?34,"Identifier"
I VBECFILE=65.4 W !,"Transfusion Reaction"
W:VBECFILE=66 !,"Blood Product",?44,"Blood Product Code"
W:VBECFILE=66.01 !,"Supplier"
W !,LINE S PAGE=PAGE+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDCNM 3929 printed Sep 23, 2025@20:20:15 Page 2
VBECDCNM ;hoifo/gjc-print unmapped data from 61.3 or 65.4;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 $$EXTERNAL^DILFD is supported by IA: 2055
+17 ;Call to ^DIR is supported by IA: 10026
+18 ;Call to $$DT^XLFDT is supported by IA: 10103
+19 ;Call to $$FMTE^XLFDT is supported by IA: 10103
+20 ;Call to $$CJ^XLFSTR is supported by IA: 10104
+21 ;Call to EN^XUTMDEVQ is supported by IA: 1519
+22 ;Execution of ^%ZOSF("TEST") is supported by IA: 10096
+23 ;
EN ; entry point for unmapped data report. this is an evocable entry point
+1 ; for the option: ???.
+2 ;
+3 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
+4 ;
RPT6005 ; Select the unmapped VistA attribute you wish to examine.
+1 ;
+2 ; initialize the error trap code
+3 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^VBECDCU1"
+4 IF '$TEST
SET X="D ERR^VBECDCU1"
SET @^%ZOSF("TRAP")
+5 ;
+6 ; select data attribute family
SET VBECS=$$ATTR^VBECDCU1()
+7 IF VBECS="^"
DO EXIT
QUIT
+8 SET VBECFILE=$PIECE(VBECS,U)
SET VBECATT=$PIECE(VBECS,U,2)
+9 ;
+10 KILL VBECS
SET VBECR="GO^VBECDCNM"
+11 FOR I="DUZ","VBECFILE","VBECATT"
SET VBECS(I)=""
+12 KILL I
SET VBECD="VBECS display currently unmapped VistA Blood bank data"
+13 SET VBECZ="MQ"
DO EN^XUTMDEVQ(VBECR,VBECD,.VBECS,,1)
+14 IF +$GET(ZTSK)>0
WRITE !!,"Task Number: "_ZTSK,!
+15 ;
EXIT ;clean up the symbol table; exit the utility
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,VBECATT,VBECIEN,VBECD,VBECFILE,VBECR,VBECS,VBECZ,X,Y,ZTSK
+2 QUIT
+3 ;
GO ; print unmapped data from file: 61.3 or 65.4
+1 ;
+2 ;Note: VBECFILE will either be 61.3 or 65.4
+3 if '$GET(VBECFILE)
QUIT
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;
+5 SET PAGE=1
SET $PIECE(LINE,"-",(IOM+1))=""
SET TODAY=$$FMTE^XLFDT($$DT^XLFDT(),"1P")
+6 DO HDR
SET (VBECXIT,VBECSTOP)=0
SET VBEC02=""
+7 FOR
SET VBEC02=$ORDER(^VBEC(6005,"N",VBEC02))
if VBEC02=""
QUIT
Begin DoDot:1
+8 SET VBECIEN=0
+9 FOR
SET VBECIEN=$ORDER(^VBEC(6005,"N",VBEC02,VBECIEN))
if 'VBECIEN
QUIT
Begin DoDot:2
+10 SET VBECY(0)=$GET(^VBEC(6005,VBECIEN,0))
+11 ;sorting by file, printing by alpha
if +$PIECE(VBECY(0),U)'=VBECFILE
QUIT
+12 ;GUID chk
if $PIECE(VBECY(0),U,5)'=""
QUIT
+13 SET VBECFIEN=$PIECE(VBECY(0),U)
SET VBECNAME=$PIECE(VBECY(0),U,2)
+14 SET VBECANTI=$$EXTERNAL^DILFD(6005,.04,,$PIECE(VBECY(0),U,4))
+15 IF $$S^%ZTLOAD()
SET (ZTSTOP,VBECSTOP)=1
QUIT
+16 ;
+17 WRITE !,VBECNAME
if VBECFILE=61.3
WRITE ?34,VBECANTI
if VBECFILE=66
WRITE ?44,$PIECE(VBECY(0),U,3)
+18 IF $Y>(IOSL-4)
DO EOS
+19 QUIT
End DoDot:2
if VBECXIT!(VBECSTOP)
QUIT
+20 QUIT
End DoDot:1
if VBECXIT!(VBECSTOP)
QUIT
+21 ;
+22 if $GET(VBECFIEN)=""
WRITE !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
+23 KILL LINE,PAGE,POP,TODAY,VBEC02,VBECANTI,VBECFIEN,VBECIEN,VBECNAME,VBECXIT,VBECY,VBECSTOP
+24 QUIT
+25 ;
EOS ; end of screen (eos) check & refresh screen action
+1 ; check to see if additional data, for this particular file,
+2 ; exists to print, if not exit w/o issuing the eos prompt.
+3 ;
+4 if $ORDER(^VBEC(6005,"B",VBECFIEN))=""
QUIT
+5 ;
+6 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET VBECXIT=$SELECT(Y'>0:1,1:0)
+7 KILL DIR,X,Y
if VBECXIT
QUIT
HDR ; draw header
+1 if ($EXTRACT(IOST)="C")!(PAGE>1)
WRITE @IOF
+2 WRITE !,$$CJ^XLFSTR("VistA Data Not Mapped To Standard SQL Server Attributes",80)
+3 WRITE !,"Date: ",TODAY,?69,"Page: ",PAGE
+4 if VBECFILE=61.3
WRITE !,"Antigen/Antibody",?34,"Identifier"
+5 IF VBECFILE=65.4
WRITE !,"Transfusion Reaction"
+6 if VBECFILE=66
WRITE !,"Blood Product",?44,"Blood Product Code"
+7 if VBECFILE=66.01
WRITE !,"Supplier"
+8 WRITE !,LINE
SET PAGE=PAGE+1
+9 QUIT
+10 ;
