VBECDCMP ;hoifo/gjc-print mapped data from VBECS MAPPING TABLE (#6005);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 data mapping report. this is an evocable entry point
; for the option: VBEC PRINT SQL/VISTA MAPPINGS.
;
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")
;
RPT6005 ; Select the mapped VistA attribute you wish to examine.
K DIR S DIR(0)="S^AA:Antigen/Antibody;TR:Transfusion Reaction",DIR("A")="Select mapped data attribute to display"
S DIR("?",1)="Enter 'AA' for Antibodies and Antigens (Vista File: Function Field #61.3)"
S DIR("?",2)="Enter 'TR' for Transfusion Reaction (VistA File: Blood Bank Utility"
S DIR("?")="#65.4)" D ^DIR
I $D(DIRUT) D EXIT Q
S VBECFILE=$S(Y="AA":61.3,1:65.4),VBECATT=Y(0)
;
; check to see that data exists in the VBECS MAPPING TABLE (#6005)
; file for the attribute selected.
I $O(^VBEC(6005,"B",$S(VBECFILE'=66.01:VBECFILE_"-",1:VBECFILE)))="" D Q
.W !!,"There is no "_VBECATT_" data in the VBECS MAPPING TABLE (#6005)"
.W !,"file to be printed.",$C(7)
.Q
;
S VBECR="GO6005^VBECDCMP"
F I="DUZ","VBECFILE","VBECATT" S VBECS(I)=""
K I S VBECD="VBECS display current data mapping relationships"
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,VBECFIEN,VBECIEN,VBECD,VBECFILE,VBECR,VBECS,VBECY,VBECZ,X,Y,ZTSK
Q
;
GO6005 ; print mapping data information from the VBECS MAPPING TABLE (#6005)
; file.
Q:'$G(VBECFILE) S:$D(ZTQUEUED) ZTREQ="@"
;
S PAGE=1,$P(LINE,"-",(IOM+1))="",TODAY=$$FMTE^XLFDT($$DT^XLFDT(),"1P")
S (VBECXIT,VBECSTOP)=0,VBECGUID="" D HDR
F S VBECGUID=$O(^VBEC(6005,"AB",VBECFILE,VBECGUID)) Q:VBECGUID="" D Q:VBECXIT!(VBECSTOP)
.S VBECIEN=0
.F S VBECIEN=$O(^VBEC(6005,"AB",VBECFILE,VBECGUID,VBECIEN)) Q:'VBECIEN D Q:VBECXIT!(VBECSTOP)
..S VBECY(0)=$G(^VBEC(6005,VBECIEN,0))
..S VBECFIEN=$P(VBECY(0),U),VBECNAME=$P(VBECY(0),U,2)
..S VBECNME=$P($G(^VBEC(6007,VBECGUID,0)),U)
..S VBECANTI=$$EXTERNAL^DILFD(6005,.04,,$P(VBECY(0),U,4))
..I $$S^%ZTLOAD() S (ZTSTOP,VBECSTOP)=1 Q
..W !!,"VistA FileMan File: "_$P(VBECFIEN,"-")
..W:$P(VBECFIEN,"-",2) !,"VistA FileMan IEN: "_$P(VBECFIEN,"-",2)
..W !,"Standard Record Name: "_VBECNME
..I $Y>(IOSL-4) D EOS Q:VBECXIT
..W !,"VistA Record Name : "_VBECNAME
..W:VBECANTI'="" !,"Antigen/Antibody : "_VBECANTI
..I $Y>(IOSL-4) D EOS
..Q
.Q
W:$G(VBECFIEN)="" !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
;
K LINE,PAGE,POP,TODAY,VBEC01,VBECANTI,VBECIEN,VBECGUID,VBECNAME,VBECNME,VBECXIT,VBECSTOP
Q
;
EOS ; end of screen (eos) check & refresh screen action
; check to see if additional data exist to print, if not exit w/o
; issuing the eos prompt.
;
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 Mapped To Standard SQL Server Attributes",IOM)
W !,"Date: ",TODAY,?69,"Page: ",PAGE,!,LINE
S PAGE=PAGE+1,HEADER="Attribute being mapped: "_VBECATT
W !,$$CJ^XLFSTR(HEADER,IOM) K HEADER
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDCMP 4498 printed Dec 13, 2024@02:44:05 Page 2
VBECDCMP ;hoifo/gjc-print mapped data from VBECS MAPPING TABLE (#6005);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 data mapping report. this is an evocable entry point
+1 ; for the option: VBEC PRINT SQL/VISTA MAPPINGS.
+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 ;
+5 ; initialize the error trap
+6 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^VBECDCU1"
+7 IF '$TEST
SET X="D ERR^VBECDCU1"
SET @^%ZOSF("TRAP")
+8 ;
RPT6005 ; Select the mapped VistA attribute you wish to examine.
+1 KILL DIR
SET DIR(0)="S^AA:Antigen/Antibody;TR:Transfusion Reaction"
SET DIR("A")="Select mapped data attribute to display"
+2 SET DIR("?",1)="Enter 'AA' for Antibodies and Antigens (Vista File: Function Field #61.3)"
+3 SET DIR("?",2)="Enter 'TR' for Transfusion Reaction (VistA File: Blood Bank Utility"
+4 SET DIR("?")="#65.4)"
DO ^DIR
+5 IF $DATA(DIRUT)
DO EXIT
QUIT
+6 SET VBECFILE=$SELECT(Y="AA":61.3,1:65.4)
SET VBECATT=Y(0)
+7 ;
+8 ; check to see that data exists in the VBECS MAPPING TABLE (#6005)
+9 ; file for the attribute selected.
+10 IF $ORDER(^VBEC(6005,"B",$SELECT(VBECFILE'=66.01:VBECFILE_"-",1:VBECFILE)))=""
Begin DoDot:1
+11 WRITE !!,"There is no "_VBECATT_" data in the VBECS MAPPING TABLE (#6005)"
+12 WRITE !,"file to be printed.",$CHAR(7)
+13 QUIT
End DoDot:1
QUIT
+14 ;
+15 SET VBECR="GO6005^VBECDCMP"
+16 FOR I="DUZ","VBECFILE","VBECATT"
SET VBECS(I)=""
+17 KILL I
SET VBECD="VBECS display current data mapping relationships"
+18 SET VBECZ="MQ"
DO EN^XUTMDEVQ(VBECR,VBECD,.VBECS,,1)
+19 IF +$GET(ZTSK)>0
WRITE !!,"Task Number: "_ZTSK,!
+20 ;
EXIT ;clean up the symbol table; exit the utility
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,VBECATT,VBECFIEN,VBECIEN,VBECD,VBECFILE,VBECR,VBECS,VBECY,VBECZ,X,Y,ZTSK
+2 QUIT
+3 ;
GO6005 ; print mapping data information from the VBECS MAPPING TABLE (#6005)
+1 ; file.
+2 if '$GET(VBECFILE)
QUIT
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 ;
+4 SET PAGE=1
SET $PIECE(LINE,"-",(IOM+1))=""
SET TODAY=$$FMTE^XLFDT($$DT^XLFDT(),"1P")
+5 SET (VBECXIT,VBECSTOP)=0
SET VBECGUID=""
DO HDR
+6 FOR
SET VBECGUID=$ORDER(^VBEC(6005,"AB",VBECFILE,VBECGUID))
if VBECGUID=""
QUIT
Begin DoDot:1
+7 SET VBECIEN=0
+8 FOR
SET VBECIEN=$ORDER(^VBEC(6005,"AB",VBECFILE,VBECGUID,VBECIEN))
if 'VBECIEN
QUIT
Begin DoDot:2
+9 SET VBECY(0)=$GET(^VBEC(6005,VBECIEN,0))
+10 SET VBECFIEN=$PIECE(VBECY(0),U)
SET VBECNAME=$PIECE(VBECY(0),U,2)
+11 SET VBECNME=$PIECE($GET(^VBEC(6007,VBECGUID,0)),U)
+12 SET VBECANTI=$$EXTERNAL^DILFD(6005,.04,,$PIECE(VBECY(0),U,4))
+13 IF $$S^%ZTLOAD()
SET (ZTSTOP,VBECSTOP)=1
QUIT
+14 WRITE !!,"VistA FileMan File: "_$PIECE(VBECFIEN,"-")
+15 if $PIECE(VBECFIEN,"-",2)
WRITE !,"VistA FileMan IEN: "_$PIECE(VBECFIEN,"-",2)
+16 WRITE !,"Standard Record Name: "_VBECNME
+17 IF $Y>(IOSL-4)
DO EOS
if VBECXIT
QUIT
+18 WRITE !,"VistA Record Name : "_VBECNAME
+19 if VBECANTI'=""
WRITE !,"Antigen/Antibody : "_VBECANTI
+20 IF $Y>(IOSL-4)
DO EOS
+21 QUIT
End DoDot:2
if VBECXIT!(VBECSTOP)
QUIT
+22 QUIT
End DoDot:1
if VBECXIT!(VBECSTOP)
QUIT
+23 if $GET(VBECFIEN)=""
WRITE !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
+24 ;
+25 KILL LINE,PAGE,POP,TODAY,VBEC01,VBECANTI,VBECIEN,VBECGUID,VBECNAME,VBECNME,VBECXIT,VBECSTOP
+26 QUIT
+27 ;
EOS ; end of screen (eos) check & refresh screen action
+1 ; check to see if additional data exist to print, if not exit w/o
+2 ; issuing the eos prompt.
+3 ;
+4 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET VBECXIT=$SELECT(Y'>0:1,1:0)
+5 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 Mapped To Standard SQL Server Attributes",IOM)
+3 WRITE !,"Date: ",TODAY,?69,"Page: ",PAGE,!,LINE
+4 SET PAGE=PAGE+1
SET HEADER="Attribute being mapped: "_VBECATT
+5 WRITE !,$$CJ^XLFSTR(HEADER,IOM)
KILL HEADER
+6 QUIT
+7 ;