LR408 ;hoifo/rlm-Disable VistA Blood Bank options ;Nov 21, 2002
;;5.2;LAB SERVICE;**408**;Sep 27, 1994;Build 8
;
;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 FILE^DIE is supported by IA: 2053
;Call to $$IENS^DILF is supported by IA: 2054
;Call to ^DIR is supported by IA: 10026
;Call to OUT^XPDMENU is supported by IA: 1157
;Call to BMES^XPDUTL is supported by IA: 10141
;Setting the "DI" node in the data dictionary supported by IA: 3805
;Setting the 'write access' (9) node in the Agglutination Strength File
; (62.55) data dictionary is supported by IA: 4468
;Setting the 'write access' (9) node in the Lab Data (63) file data
; dictionary is supported by IA: 4469
;
EN ;
I $P($G(^VBEC(6009,65.5,0)),"^",3)="Y" S LRVBTXT="Options, files, and fields have already been disabled at "_$P($$SITE^VASITE,"^",2) G MSG
S LRVBFLG=1,LRVBTXT="Options, files, and fields have been disabled at "_$P($$SITE^VASITE,"^",2)
S I=0 F S I=$O(^VBEC(6003,I)) Q:'I D
.S OPT=$P($G(^VBEC(6003,I,0)),U)
.Q:OPT="LRBLAD"!(OPT="LRBLPC")!(OPT="LRBLSI")
.S TXT=$S(LRVBFLG=1:"out-of-order",1:"@")
.D OUT^XPDMENU(OPT,TXT)
.Q
K I,OPT,TXT
; Note: Using Integration Agreement# 3805 to set and kill the
; ^DD(file#,0,"DI") node.
;
;
S GG=0,U="^" W !,"Finished disabling specific VistA Blood Bank components."
F S GG=$O(^VBEC(6009,GG)) Q:'GG D
.;
.; need to check if only whole file restrictions apply, or if a
.; sub-file/field levels are involved
.;
.I +$O(^VBEC(6009,GG,"DD",0)) D
..;
..; sub-file/field levels exist
..;
..S HH=0 F S HH=$O(^VBEC(6009,GG,"DD",HH)) Q:'HH D
...S LRVBIEN(1)=GG,LRVBIEN=HH,LRVBIENS=$$IENS^DILF(.LRVBIEN)
...I LRVBFLG=1 D
....;
....; 1) obtain sub-file and field information
....; 2) set pre-conv. field write access to pre-conv. value
....; 3) set pst-conv. field write access to pst-conv. value
....; 4) hardset write node access
....; 5) file data tracking pre/post conversion field level values
....;
....S LRVBNODE=$G(^VBEC(6009,GG,"DD",HH,0))
....S LRVBFLD=$P(LRVBNODE,U,2),LRVBFLE=$P(LRVBNODE,U) ;(1)
....S LRVBB4=$G(^DD(LRVBFLE,LRVBFLD,9))
....S:LRVBB4]"" LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4 ;(2)
....S VBECFDA(6009.01,LRVBIENS,2)="^" ;(3)
....S ^DD(LRVBFLE,LRVBFLD,9)="^" ;(4)
....D FILE^DIE("","LRVBFDA") ;(5)
....Q
...E D
....;
....; 1) obtain sub-file and field information
....; 2) set pre-conv. field to pre-conv. write access value
....; 2A) if pre-conv value was null delete data in the field
....; 2B) if pre-conv value was not null restore the field to
....; the pre-conv value of the field
....; 3) set write access node to pre-conv. value (if any)
....; 4) kill write access data dictionary node if no pre-conv. value
....; 5) set pst-conv write access field to null
....; 6) file data tracking pre-conversion field level values
....;
....S LRVBNODE=$G(^VBEC(6009,GG,"DD",HH,0))
....S LRVBFLD=$P(LRVBNODE,U,2),LRVBFLE=$P(LRVBNODE,U) ;(1)
....S LRVBB4=$G(^VBEC(6009,GG,"DD",HH,"PREW"))
....S:LRVBB4="" LRVBFDA(6009.01,LRVBIENS,1)="@" ;(2A)
....S:LRVBB4]"" LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4 ;(2B)
....S:LRVBB4]"" ^DD(LRVBFLE,LRVBFLD,9)=LRVBB4 ;(3)
....K:LRVBB4="" ^DD(LRVBFLE,LRVBFLD,9) ;(4)
....S LRVBFDA(6009.01,LRVBIENS,2)="@" ;(5)
....D FILE^DIE("","LRVBFDA") ;(6)
....Q
...K LRVBB4,LRVBFDA,LRVBFLD,LRVBFLE,LRVBIENS,LRVBNODE
...Q
..K HH
..Q
.;
.; whole file restriction check
.;
.D
..;
..; Disabling file access, or imposing file restrictions
..; 1) find the file restriction value before the data conversion
..; (no pre-data conversion file level restrictions anticipated)
..; 1A) if pre-conv value was not null set the field to the
..; pre-conv value of the field
..; 2) hard set the 2nd piece of ^DD(File#,0,"DI") to "Y"
..; 3) Set pst-conversion file restriction value,'Y' into the correct
..; field (#.03)
..; 4) file the data.
..;
..Q:$D(^VBEC(6009,GG,"DD"))
..S LRVBB4=$P($G(^DD(GG,0,"DI")),U,2) ;(1)
..S:LRVBB4]"" LRVBFDA(6009,GG_",",.02)=LRVBB4 ;(1A)
..S $P(^DD(GG,0,"DI"),U,2)="Y" ;(2)
..S LRVBFDA(6009,GG_",",.03)="Y" ;(3)
..D FILE^DIE("","LRVBFDA") ;(4)
..Q
.K LRVBB4,LRVBFDA
.Q
K GG,LRVBMSG
MSG ;Send a message showing success.
K ^TMP("VBEC",$J)
s ^TMP("VBEC",$J,1,0)=LRVBTXT
s XMSUB="LR*5.2*408 Patch Installation verification",XMTEXT="^TMP(""VBEC"",$J)",XMDUN="Vista BB Patch Monitor"
s XMY("G.VBEC@DOMAIN.EXT")=""
d SENDMSG^XMXAPI(DUZ,XMSUB,XMTEXT,.XMY)
k ^TMP("VBEC",$J),XMY
q ;
ZEOR ;LR408
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR408 5148 printed Sep 23, 2025@19:39:36 Page 2
LR408 ;hoifo/rlm-Disable VistA Blood Bank options ;Nov 21, 2002
+1 ;;5.2;LAB SERVICE;**408**;Sep 27, 1994;Build 8
+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 FILE^DIE is supported by IA: 2053
+15 ;Call to $$IENS^DILF is supported by IA: 2054
+16 ;Call to ^DIR is supported by IA: 10026
+17 ;Call to OUT^XPDMENU is supported by IA: 1157
+18 ;Call to BMES^XPDUTL is supported by IA: 10141
+19 ;Setting the "DI" node in the data dictionary supported by IA: 3805
+20 ;Setting the 'write access' (9) node in the Agglutination Strength File
+21 ; (62.55) data dictionary is supported by IA: 4468
+22 ;Setting the 'write access' (9) node in the Lab Data (63) file data
+23 ; dictionary is supported by IA: 4469
+24 ;
EN ;
+1 IF $PIECE($GET(^VBEC(6009,65.5,0)),"^",3)="Y"
SET LRVBTXT="Options, files, and fields have already been disabled at "_$PIECE($$SITE^VASITE,"^",2)
GOTO MSG
+2 SET LRVBFLG=1
SET LRVBTXT="Options, files, and fields have been disabled at "_$PIECE($$SITE^VASITE,"^",2)
+3 SET I=0
FOR
SET I=$ORDER(^VBEC(6003,I))
if 'I
QUIT
Begin DoDot:1
+4 SET OPT=$PIECE($GET(^VBEC(6003,I,0)),U)
+5 if OPT="LRBLAD"!(OPT="LRBLPC")!(OPT="LRBLSI")
QUIT
+6 SET TXT=$SELECT(LRVBFLG=1:"out-of-order",1:"@")
+7 DO OUT^XPDMENU(OPT,TXT)
+8 QUIT
End DoDot:1
+9 KILL I,OPT,TXT
+10 ; Note: Using Integration Agreement# 3805 to set and kill the
+11 ; ^DD(file#,0,"DI") node.
+12 ;
+13 ;
+14 SET GG=0
SET U="^"
WRITE !,"Finished disabling specific VistA Blood Bank components."
+15 FOR
SET GG=$ORDER(^VBEC(6009,GG))
if 'GG
QUIT
Begin DoDot:1
+16 ;
+17 ; need to check if only whole file restrictions apply, or if a
+18 ; sub-file/field levels are involved
+19 ;
+20 IF +$ORDER(^VBEC(6009,GG,"DD",0))
Begin DoDot:2
+21 ;
+22 ; sub-file/field levels exist
+23 ;
+24 SET HH=0
FOR
SET HH=$ORDER(^VBEC(6009,GG,"DD",HH))
if 'HH
QUIT
Begin DoDot:3
+25 SET LRVBIEN(1)=GG
SET LRVBIEN=HH
SET LRVBIENS=$$IENS^DILF(.LRVBIEN)
+26 IF LRVBFLG=1
Begin DoDot:4
+27 ;
+28 ; 1) obtain sub-file and field information
+29 ; 2) set pre-conv. field write access to pre-conv. value
+30 ; 3) set pst-conv. field write access to pst-conv. value
+31 ; 4) hardset write node access
+32 ; 5) file data tracking pre/post conversion field level values
+33 ;
+34 SET LRVBNODE=$GET(^VBEC(6009,GG,"DD",HH,0))
+35 ;(1)
SET LRVBFLD=$PIECE(LRVBNODE,U,2)
SET LRVBFLE=$PIECE(LRVBNODE,U)
+36 SET LRVBB4=$GET(^DD(LRVBFLE,LRVBFLD,9))
+37 ;(2)
if LRVBB4]""
SET LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4
+38 ;(3)
SET VBECFDA(6009.01,LRVBIENS,2)="^"
+39 ;(4)
SET ^DD(LRVBFLE,LRVBFLD,9)="^"
+40 ;(5)
DO FILE^DIE("","LRVBFDA")
+41 QUIT
End DoDot:4
+42 IF '$TEST
Begin DoDot:4
+43 ;
+44 ; 1) obtain sub-file and field information
+45 ; 2) set pre-conv. field to pre-conv. write access value
+46 ; 2A) if pre-conv value was null delete data in the field
+47 ; 2B) if pre-conv value was not null restore the field to
+48 ; the pre-conv value of the field
+49 ; 3) set write access node to pre-conv. value (if any)
+50 ; 4) kill write access data dictionary node if no pre-conv. value
+51 ; 5) set pst-conv write access field to null
+52 ; 6) file data tracking pre-conversion field level values
+53 ;
+54 SET LRVBNODE=$GET(^VBEC(6009,GG,"DD",HH,0))
+55 ;(1)
SET LRVBFLD=$PIECE(LRVBNODE,U,2)
SET LRVBFLE=$PIECE(LRVBNODE,U)
+56 SET LRVBB4=$GET(^VBEC(6009,GG,"DD",HH,"PREW"))
+57 ;(2A)
if LRVBB4=""
SET LRVBFDA(6009.01,LRVBIENS,1)="@"
+58 ;(2B)
if LRVBB4]""
SET LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4
+59 ;(3)
if LRVBB4]""
SET ^DD(LRVBFLE,LRVBFLD,9)=LRVBB4
+60 ;(4)
if LRVBB4=""
KILL ^DD(LRVBFLE,LRVBFLD,9)
+61 ;(5)
SET LRVBFDA(6009.01,LRVBIENS,2)="@"
+62 ;(6)
DO FILE^DIE("","LRVBFDA")
+63 QUIT
End DoDot:4
+64 KILL LRVBB4,LRVBFDA,LRVBFLD,LRVBFLE,LRVBIENS,LRVBNODE
+65 QUIT
End DoDot:3
+66 KILL HH
+67 QUIT
End DoDot:2
+68 ;
+69 ; whole file restriction check
+70 ;
+71 Begin DoDot:2
+72 ;
+73 ; Disabling file access, or imposing file restrictions
+74 ; 1) find the file restriction value before the data conversion
+75 ; (no pre-data conversion file level restrictions anticipated)
+76 ; 1A) if pre-conv value was not null set the field to the
+77 ; pre-conv value of the field
+78 ; 2) hard set the 2nd piece of ^DD(File#,0,"DI") to "Y"
+79 ; 3) Set pst-conversion file restriction value,'Y' into the correct
+80 ; field (#.03)
+81 ; 4) file the data.
+82 ;
+83 if $DATA(^VBEC(6009,GG,"DD"))
QUIT
+84 ;(1)
SET LRVBB4=$PIECE($GET(^DD(GG,0,"DI")),U,2)
+85 ;(1A)
if LRVBB4]""
SET LRVBFDA(6009,GG_",",.02)=LRVBB4
+86 ;(2)
SET $PIECE(^DD(GG,0,"DI"),U,2)="Y"
+87 ;(3)
SET LRVBFDA(6009,GG_",",.03)="Y"
+88 ;(4)
DO FILE^DIE("","LRVBFDA")
+89 QUIT
End DoDot:2
+90 KILL LRVBB4,LRVBFDA
+91 QUIT
End DoDot:1
+92 KILL GG,LRVBMSG
MSG ;Send a message showing success.
+1 KILL ^TMP("VBEC",$JOB)
+2 SET ^TMP("VBEC",$JOB,1,0)=LRVBTXT
+3 SET XMSUB="LR*5.2*408 Patch Installation verification"
SET XMTEXT="^TMP(""VBEC"",$J)"
SET XMDUN="Vista BB Patch Monitor"
+4 SET XMY("G.VBEC@DOMAIN.EXT")=""
+5 DO SENDMSG^XMXAPI(DUZ,XMSUB,XMTEXT,.XMY)
+6 KILL ^TMP("VBEC",$JOB),XMY
+7 ;
QUIT
ZEOR ;LR408
