- VBECDC19 ;hoifo/gjc-utilities for VistA Blood Bank options (#19);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 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(VBECFLG) ;
- ;input: VBECFLG=1 set options 'out-of-order', else place options
- ; in order.
- ;
- ; call to OUT^XPDMENU(OPT,TXT) supported by IA: 1157
- ;
- ; Need to check if this option is independently invoked, or executed
- ; during the data conversion process. If independent, ask the user for
- ; his/her real intentions. VBECECHO is set in the Entry/Exit Action
- ; fields in the option file for options: VBEC BB COMPONENTS ENABLE &
- ; VBEC BB COMPONENTS DISABLE
- ;
- I $D(VBECECHO)#2 D
- .S X=$S(VBECFLG=1:"dis",1:"en")_"able"
- .S DIR(0)="Y",DIR("A",1)=" ",DIR("A",2)="Are you sure you want to "_X_" specific VistA Blood Bank option, files,",DIR("A")="and fields"
- .S DIR("B")="No",DIR("?")="Enter 'Yes' to "_X_" selected components, or 'No' to exit without taking action." D ^DIR
- .S:$D(DIRUT) VBECYN=0
- .S:'$D(DIRUT) VBECYN=+Y ;1 for yes, 0 for no
- .K DIR,DIROUT,DIRUT,DTOUT,DUOUT,VBECACTN,X,Y
- .Q
- I $G(VBECYN)=0 K VBECYN Q
- I VBECFLG,$P($G(^VBEC(6009,65.5,0)),"^",3)="Y" W:$D(VBECECHO)#2 !,"Options, files, and fields have already been disabled." Q ;RLM 10/31/05
- ;
- S VBECMSG="finished setting specific VistA Blood Bank options "_$S(VBECFLG=1:"'Out-of-Order'",1:"'In Order'")_"."
- 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(VBECFLG=1:"out-of-order",1:"@")
- .D OUT^XPDMENU(OPT,TXT)
- .Q
- D BMES^XPDUTL(VBECMSG)
- K I,OPT,TXT,VBECMSG
- D EN1(VBECFLG) ; set file level and field level access
- Q
- ;
- EN1(VBECFLG) ;
- ;input: VBECFLG=1 disable sub-file data dictionary (write access)
- ; or set the file restriction node ^DD(file#,0,"DI")
- ;
- ; VBECFLG=0 enable sub-file data dictionary nodes (write access)
- ; or kill the file restriction node ^DD(file#,0,"DI")
- ;
- ; Note: this routine called from VBECDC19
- ;
- ; Note: Using Integration Agreement# 3805 to set and kill the
- ; ^DD(file#,0,"DI") node.
- ;
- ;
- I VBECFLG,$P($G(^VBEC(6009,65.5,0)),"^",3)="Y" W:$D(VBECECHO)#2 !,"Options, files, and fields have already been disabled." Q ;RLM 10/31/05
- N VBECIEN S GG=0,U="^",VBECMSG="Finished "_$S(VBECFLG=1:"dis",1:"en")_"abling 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 VBECIEN(1)=GG,VBECIEN=HH,VBECIENS=$$IENS^DILF(.VBECIEN)
- ...I VBECFLG=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 VBECNODE=$G(^VBEC(6009,GG,"DD",HH,0))
- ....S VBECFLD=$P(VBECNODE,U,2),VBECFLE=$P(VBECNODE,U) ;(1)
- ....S VBECB4=$G(^DD(VBECFLE,VBECFLD,9))
- ....S:VBECB4]"" VBECFDA(6009.01,VBECIENS,1)=VBECB4 ;(2)
- ....S VBECFDA(6009.01,VBECIENS,2)="^" ;(3)
- ....S ^DD(VBECFLE,VBECFLD,9)="^" ;(4)
- ....D FILE^DIE("","VBECFDA") ;(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 VBECNODE=$G(^VBEC(6009,GG,"DD",HH,0))
- ....S VBECFLD=$P(VBECNODE,U,2),VBECFLE=$P(VBECNODE,U) ;(1)
- ....S VBECB4=$G(^VBEC(6009,GG,"DD",HH,"PREW"))
- ....S:VBECB4="" VBECFDA(6009.01,VBECIENS,1)="@" ;(2A)
- ....S:VBECB4]"" VBECFDA(6009.01,VBECIENS,1)=VBECB4 ;(2B)
- ....S:VBECB4]"" ^DD(VBECFLE,VBECFLD,9)=VBECB4 ;(3)
- ....K:VBECB4="" ^DD(VBECFLE,VBECFLD,9) ;(4)
- ....S VBECFDA(6009.01,VBECIENS,2)="@" ;(5)
- ....D FILE^DIE("","VBECFDA") ;(6)
- ....Q
- ...K VBECB4,VBECFDA,VBECFLD,VBECFLE,VBECIENS,VBECNODE
- ...Q
- ..K HH
- ..Q
- .;
- .; whole file restriction check
- .;
- .I VBECFLG=1 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")) ;RLM 10/31/05
- ..S VBECB4=$P($G(^DD(GG,0,"DI")),U,2) ;(1)
- ..S:VBECB4]"" VBECFDA(6009,GG_",",.02)=VBECB4 ;(1A)
- ..S $P(^DD(GG,0,"DI"),U,2)="Y" ;(2)
- ..S VBECFDA(6009,GG_",",.03)="Y" ;(3)
- ..D FILE^DIE("","VBECFDA") ;(4)
- ..Q
- .E D
- ..;
- ..; Enabling file access, or lifting the file restriction
- ..; 1) find the file restriction value before the data conversion
- ..; (no file level restrictions are expected on these files prior
- ..; to the data conversion).
- ..; 2) restore the data dictionary to its pre-conversion state (if
- ..; ^DD(GG,0,"DI") didn't exist prior to the conversion, it will
- ..; after the restore. The key fact is that the first & second
- ..; pieces of the "DI" node will be null)
- ..; 3) if file restriction exists, track in the pre-conv. value field
- ..; 4) update the pre-conversion restriction tracking field to null
- ..; 5) update the post-conversion restriction tracking field to null
- ..; 6) file the data into the file
- ..;
- ..S VBECB4=$P(^VBEC(6009,GG,0),U,2) ;(1)
- ..S $P(^DD(GG,0,"DI"),U,2)=VBECB4 ;(2)
- ..S:VBECB4="" VBECFDA(6009,GG_",",.02)="@" ;(3)
- ..S:VBECB4]"" VBECFDA(6009,GG_",",.02)=VBECB4 ;(4)
- ..S VBECFDA(6009,GG_",",.03)="@" ;(5)
- ..D FILE^DIE("","VBECFDA") ;(6)
- ..Q
- .K VBECB4,VBECFDA
- .Q
- D BMES^XPDUTL(VBECMSG)
- K GG,VBECMSG
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDC19 7510 printed Feb 19, 2025@00:10:29 Page 2
- VBECDC19 ;hoifo/gjc-utilities for VistA Blood Bank options (#19);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 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(VBECFLG) ;
- +1 ;input: VBECFLG=1 set options 'out-of-order', else place options
- +2 ; in order.
- +3 ;
- +4 ; call to OUT^XPDMENU(OPT,TXT) supported by IA: 1157
- +5 ;
- +6 ; Need to check if this option is independently invoked, or executed
- +7 ; during the data conversion process. If independent, ask the user for
- +8 ; his/her real intentions. VBECECHO is set in the Entry/Exit Action
- +9 ; fields in the option file for options: VBEC BB COMPONENTS ENABLE &
- +10 ; VBEC BB COMPONENTS DISABLE
- +11 ;
- +12 IF $DATA(VBECECHO)#2
- Begin DoDot:1
- +13 SET X=$SELECT(VBECFLG=1:"dis",1:"en")_"able"
- +14 SET DIR(0)="Y"
- SET DIR("A",1)=" "
- SET DIR("A",2)="Are you sure you want to "_X_" specific VistA Blood Bank option, files,"
- SET DIR("A")="and fields"
- +15 SET DIR("B")="No"
- SET DIR("?")="Enter 'Yes' to "_X_" selected components, or 'No' to exit without taking action."
- DO ^DIR
- +16 if $DATA(DIRUT)
- SET VBECYN=0
- +17 ;1 for yes, 0 for no
- if '$DATA(DIRUT)
- SET VBECYN=+Y
- +18 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,VBECACTN,X,Y
- +19 QUIT
- End DoDot:1
- +20 IF $GET(VBECYN)=0
- KILL VBECYN
- QUIT
- +21 ;RLM 10/31/05
- IF VBECFLG
- IF $PIECE($GET(^VBEC(6009,65.5,0)),"^",3)="Y"
- if $DATA(VBECECHO)#2
- WRITE !,"Options, files, and fields have already been disabled."
- QUIT
- +22 ;
- +23 SET VBECMSG="finished setting specific VistA Blood Bank options "_$SELECT(VBECFLG=1:"'Out-of-Order'",1:"'In Order'")_"."
- +24 SET I=0
- FOR
- SET I=$ORDER(^VBEC(6003,I))
- if 'I
- QUIT
- Begin DoDot:1
- +25 SET OPT=$PIECE($GET(^VBEC(6003,I,0)),U)
- +26 if OPT="LRBLAD"!(OPT="LRBLPC")!(OPT="LRBLSI")
- QUIT
- +27 SET TXT=$SELECT(VBECFLG=1:"out-of-order",1:"@")
- +28 DO OUT^XPDMENU(OPT,TXT)
- +29 QUIT
- End DoDot:1
- +30 DO BMES^XPDUTL(VBECMSG)
- +31 KILL I,OPT,TXT,VBECMSG
- +32 ; set file level and field level access
- DO EN1(VBECFLG)
- +33 QUIT
- +34 ;
- EN1(VBECFLG) ;
- +1 ;input: VBECFLG=1 disable sub-file data dictionary (write access)
- +2 ; or set the file restriction node ^DD(file#,0,"DI")
- +3 ;
- +4 ; VBECFLG=0 enable sub-file data dictionary nodes (write access)
- +5 ; or kill the file restriction node ^DD(file#,0,"DI")
- +6 ;
- +7 ; Note: this routine called from VBECDC19
- +8 ;
- +9 ; Note: Using Integration Agreement# 3805 to set and kill the
- +10 ; ^DD(file#,0,"DI") node.
- +11 ;
- +12 ;
- +13 ;RLM 10/31/05
- IF VBECFLG
- IF $PIECE($GET(^VBEC(6009,65.5,0)),"^",3)="Y"
- if $DATA(VBECECHO)#2
- WRITE !,"Options, files, and fields have already been disabled."
- QUIT
- +14 NEW VBECIEN
- SET GG=0
- SET U="^"
- SET VBECMSG="Finished "_$SELECT(VBECFLG=1:"dis",1:"en")_"abling 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 VBECIEN(1)=GG
- SET VBECIEN=HH
- SET VBECIENS=$$IENS^DILF(.VBECIEN)
- +26 IF VBECFLG=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 VBECNODE=$GET(^VBEC(6009,GG,"DD",HH,0))
- +35 ;(1)
- SET VBECFLD=$PIECE(VBECNODE,U,2)
- SET VBECFLE=$PIECE(VBECNODE,U)
- +36 SET VBECB4=$GET(^DD(VBECFLE,VBECFLD,9))
- +37 ;(2)
- if VBECB4]""
- SET VBECFDA(6009.01,VBECIENS,1)=VBECB4
- +38 ;(3)
- SET VBECFDA(6009.01,VBECIENS,2)="^"
- +39 ;(4)
- SET ^DD(VBECFLE,VBECFLD,9)="^"
- +40 ;(5)
- DO FILE^DIE("","VBECFDA")
- +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 VBECNODE=$GET(^VBEC(6009,GG,"DD",HH,0))
- +55 ;(1)
- SET VBECFLD=$PIECE(VBECNODE,U,2)
- SET VBECFLE=$PIECE(VBECNODE,U)
- +56 SET VBECB4=$GET(^VBEC(6009,GG,"DD",HH,"PREW"))
- +57 ;(2A)
- if VBECB4=""
- SET VBECFDA(6009.01,VBECIENS,1)="@"
- +58 ;(2B)
- if VBECB4]""
- SET VBECFDA(6009.01,VBECIENS,1)=VBECB4
- +59 ;(3)
- if VBECB4]""
- SET ^DD(VBECFLE,VBECFLD,9)=VBECB4
- +60 ;(4)
- if VBECB4=""
- KILL ^DD(VBECFLE,VBECFLD,9)
- +61 ;(5)
- SET VBECFDA(6009.01,VBECIENS,2)="@"
- +62 ;(6)
- DO FILE^DIE("","VBECFDA")
- +63 QUIT
- End DoDot:4
- +64 KILL VBECB4,VBECFDA,VBECFLD,VBECFLE,VBECIENS,VBECNODE
- +65 QUIT
- End DoDot:3
- +66 KILL HH
- +67 QUIT
- End DoDot:2
- +68 ;
- +69 ; whole file restriction check
- +70 ;
- +71 IF VBECFLG=1
- 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 ;RLM 10/31/05
- if $DATA(^VBEC(6009,GG,"DD"))
- QUIT
- +84 ;(1)
- SET VBECB4=$PIECE($GET(^DD(GG,0,"DI")),U,2)
- +85 ;(1A)
- if VBECB4]""
- SET VBECFDA(6009,GG_",",.02)=VBECB4
- +86 ;(2)
- SET $PIECE(^DD(GG,0,"DI"),U,2)="Y"
- +87 ;(3)
- SET VBECFDA(6009,GG_",",.03)="Y"
- +88 ;(4)
- DO FILE^DIE("","VBECFDA")
- +89 QUIT
- End DoDot:2
- +90 IF '$TEST
- Begin DoDot:2
- +91 ;
- +92 ; Enabling file access, or lifting the file restriction
- +93 ; 1) find the file restriction value before the data conversion
- +94 ; (no file level restrictions are expected on these files prior
- +95 ; to the data conversion).
- +96 ; 2) restore the data dictionary to its pre-conversion state (if
- +97 ; ^DD(GG,0,"DI") didn't exist prior to the conversion, it will
- +98 ; after the restore. The key fact is that the first & second
- +99 ; pieces of the "DI" node will be null)
- +100 ; 3) if file restriction exists, track in the pre-conv. value field
- +101 ; 4) update the pre-conversion restriction tracking field to null
- +102 ; 5) update the post-conversion restriction tracking field to null
- +103 ; 6) file the data into the file
- +104 ;
- +105 ;(1)
- SET VBECB4=$PIECE(^VBEC(6009,GG,0),U,2)
- +106 ;(2)
- SET $PIECE(^DD(GG,0,"DI"),U,2)=VBECB4
- +107 ;(3)
- if VBECB4=""
- SET VBECFDA(6009,GG_",",.02)="@"
- +108 ;(4)
- if VBECB4]""
- SET VBECFDA(6009,GG_",",.02)=VBECB4
- +109 ;(5)
- SET VBECFDA(6009,GG_",",.03)="@"
- +110 ;(6)
- DO FILE^DIE("","VBECFDA")
- +111 QUIT
- End DoDot:2
- +112 KILL VBECB4,VBECFDA
- +113 QUIT
- End DoDot:1
- +114 DO BMES^XPDUTL(VBECMSG)
- +115 KILL GG,VBECMSG
- +116 QUIT
- +117 ;