Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VBECDC19

VBECDC19.m

Go to the documentation of this file.
  1. VBECDC19 ;hoifo/gjc-utilities for VistA Blood Bank options (#19);Nov 21, 2002
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ;Medical Device #:
  1. ;Note: The food and Drug Administration classifies this software as a
  1. ;medical device. As such, it may not be changed in any way.
  1. ;Modifications to this software may result in an adulterated medical
  1. ;device under 21CFR820, the use of which is considered to be a
  1. ;violation of US Federal Statutes. Acquiring and implementing this
  1. ;software through the Freedom of Information Act requires the
  1. ;implementer to assume total responsibility for the software, and
  1. ;become a registered manufacturer of a medical device, subject to FDA
  1. ;regulations.
  1. ;
  1. ;Call to FILE^DIE is supported by IA: 2053
  1. ;Call to $$IENS^DILF is supported by IA: 2054
  1. ;Call to ^DIR is supported by IA: 10026
  1. ;Call to OUT^XPDMENU is supported by IA: 1157
  1. ;Call to BMES^XPDUTL is supported by IA: 10141
  1. ;Setting the "DI" node in the data dictionary supported by IA: 3805
  1. ;Setting the 'write access' (9) node in the Agglutination Strength File
  1. ; (62.55) data dictionary is supported by IA: 4468
  1. ;Setting the 'write access' (9) node in the Lab Data (63) file data
  1. ; dictionary is supported by IA: 4469
  1. ;
  1. EN(VBECFLG) ;
  1. ;input: VBECFLG=1 set options 'out-of-order', else place options
  1. ; in order.
  1. ;
  1. ; call to OUT^XPDMENU(OPT,TXT) supported by IA: 1157
  1. ;
  1. ; Need to check if this option is independently invoked, or executed
  1. ; during the data conversion process. If independent, ask the user for
  1. ; his/her real intentions. VBECECHO is set in the Entry/Exit Action
  1. ; fields in the option file for options: VBEC BB COMPONENTS ENABLE &
  1. ; VBEC BB COMPONENTS DISABLE
  1. ;
  1. I $D(VBECECHO)#2 D
  1. .S X=$S(VBECFLG=1:"dis",1:"en")_"able"
  1. .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"
  1. .S DIR("B")="No",DIR("?")="Enter 'Yes' to "_X_" selected components, or 'No' to exit without taking action." D ^DIR
  1. .S:$D(DIRUT) VBECYN=0
  1. .S:'$D(DIRUT) VBECYN=+Y ;1 for yes, 0 for no
  1. .K DIR,DIROUT,DIRUT,DTOUT,DUOUT,VBECACTN,X,Y
  1. .Q
  1. I $G(VBECYN)=0 K VBECYN Q
  1. 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
  1. ;
  1. S VBECMSG="finished setting specific VistA Blood Bank options "_$S(VBECFLG=1:"'Out-of-Order'",1:"'In Order'")_"."
  1. S I=0 F S I=$O(^VBEC(6003,I)) Q:'I D
  1. .S OPT=$P($G(^VBEC(6003,I,0)),U)
  1. .Q:OPT="LRBLAD"!(OPT="LRBLPC")!(OPT="LRBLSI")
  1. .S TXT=$S(VBECFLG=1:"out-of-order",1:"@")
  1. .D OUT^XPDMENU(OPT,TXT)
  1. .Q
  1. D BMES^XPDUTL(VBECMSG)
  1. K I,OPT,TXT,VBECMSG
  1. D EN1(VBECFLG) ; set file level and field level access
  1. Q
  1. ;
  1. EN1(VBECFLG) ;
  1. ;input: VBECFLG=1 disable sub-file data dictionary (write access)
  1. ; or set the file restriction node ^DD(file#,0,"DI")
  1. ;
  1. ; VBECFLG=0 enable sub-file data dictionary nodes (write access)
  1. ; or kill the file restriction node ^DD(file#,0,"DI")
  1. ;
  1. ; Note: this routine called from VBECDC19
  1. ;
  1. ; Note: Using Integration Agreement# 3805 to set and kill the
  1. ; ^DD(file#,0,"DI") node.
  1. ;
  1. ;
  1. 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
  1. N VBECIEN S GG=0,U="^",VBECMSG="Finished "_$S(VBECFLG=1:"dis",1:"en")_"abling specific VistA Blood Bank components."
  1. F S GG=$O(^VBEC(6009,GG)) Q:'GG D
  1. .;
  1. .; need to check if only whole file restrictions apply, or if a
  1. .; sub-file/field levels are involved
  1. .;
  1. .I +$O(^VBEC(6009,GG,"DD",0)) D
  1. ..;
  1. ..; sub-file/field levels exist
  1. ..;
  1. ..S HH=0 F S HH=$O(^VBEC(6009,GG,"DD",HH)) Q:'HH D
  1. ...S VBECIEN(1)=GG,VBECIEN=HH,VBECIENS=$$IENS^DILF(.VBECIEN)
  1. ...I VBECFLG=1 D
  1. ....;
  1. ....; 1) obtain sub-file and field information
  1. ....; 2) set pre-conv. field write access to pre-conv. value
  1. ....; 3) set pst-conv. field write access to pst-conv. value
  1. ....; 4) hardset write node access
  1. ....; 5) file data tracking pre/post conversion field level values
  1. ....;
  1. ....S VBECNODE=$G(^VBEC(6009,GG,"DD",HH,0))
  1. ....S VBECFLD=$P(VBECNODE,U,2),VBECFLE=$P(VBECNODE,U) ;(1)
  1. ....S VBECB4=$G(^DD(VBECFLE,VBECFLD,9))
  1. ....S:VBECB4]"" VBECFDA(6009.01,VBECIENS,1)=VBECB4 ;(2)
  1. ....S VBECFDA(6009.01,VBECIENS,2)="^" ;(3)
  1. ....S ^DD(VBECFLE,VBECFLD,9)="^" ;(4)
  1. ....D FILE^DIE("","VBECFDA") ;(5)
  1. ....Q
  1. ...E D
  1. ....;
  1. ....; 1) obtain sub-file and field information
  1. ....; 2) set pre-conv. field to pre-conv. write access value
  1. ....; 2A) if pre-conv value was null delete data in the field
  1. ....; 2B) if pre-conv value was not null restore the field to
  1. ....; the pre-conv value of the field
  1. ....; 3) set write access node to pre-conv. value (if any)
  1. ....; 4) kill write access data dictionary node if no pre-conv. value
  1. ....; 5) set pst-conv write access field to null
  1. ....; 6) file data tracking pre-conversion field level values
  1. ....;
  1. ....S VBECNODE=$G(^VBEC(6009,GG,"DD",HH,0))
  1. ....S VBECFLD=$P(VBECNODE,U,2),VBECFLE=$P(VBECNODE,U) ;(1)
  1. ....S VBECB4=$G(^VBEC(6009,GG,"DD",HH,"PREW"))
  1. ....S:VBECB4="" VBECFDA(6009.01,VBECIENS,1)="@" ;(2A)
  1. ....S:VBECB4]"" VBECFDA(6009.01,VBECIENS,1)=VBECB4 ;(2B)
  1. ....S:VBECB4]"" ^DD(VBECFLE,VBECFLD,9)=VBECB4 ;(3)
  1. ....K:VBECB4="" ^DD(VBECFLE,VBECFLD,9) ;(4)
  1. ....S VBECFDA(6009.01,VBECIENS,2)="@" ;(5)
  1. ....D FILE^DIE("","VBECFDA") ;(6)
  1. ....Q
  1. ...K VBECB4,VBECFDA,VBECFLD,VBECFLE,VBECIENS,VBECNODE
  1. ...Q
  1. ..K HH
  1. ..Q
  1. .;
  1. .; whole file restriction check
  1. .;
  1. .I VBECFLG=1 D
  1. ..;
  1. ..; Disabling file access, or imposing file restrictions
  1. ..; 1) find the file restriction value before the data conversion
  1. ..; (no pre-data conversion file level restrictions anticipated)
  1. ..; 1A) if pre-conv value was not null set the field to the
  1. ..; pre-conv value of the field
  1. ..; 2) hard set the 2nd piece of ^DD(File#,0,"DI") to "Y"
  1. ..; 3) Set pst-conversion file restriction value,'Y' into the correct
  1. ..; field (#.03)
  1. ..; 4) file the data.
  1. ..;
  1. ..Q:$D(^VBEC(6009,GG,"DD")) ;RLM 10/31/05
  1. ..S VBECB4=$P($G(^DD(GG,0,"DI")),U,2) ;(1)
  1. ..S:VBECB4]"" VBECFDA(6009,GG_",",.02)=VBECB4 ;(1A)
  1. ..S $P(^DD(GG,0,"DI"),U,2)="Y" ;(2)
  1. ..S VBECFDA(6009,GG_",",.03)="Y" ;(3)
  1. ..D FILE^DIE("","VBECFDA") ;(4)
  1. ..Q
  1. .E D
  1. ..;
  1. ..; Enabling file access, or lifting the file restriction
  1. ..; 1) find the file restriction value before the data conversion
  1. ..; (no file level restrictions are expected on these files prior
  1. ..; to the data conversion).
  1. ..; 2) restore the data dictionary to its pre-conversion state (if
  1. ..; ^DD(GG,0,"DI") didn't exist prior to the conversion, it will
  1. ..; after the restore. The key fact is that the first & second
  1. ..; pieces of the "DI" node will be null)
  1. ..; 3) if file restriction exists, track in the pre-conv. value field
  1. ..; 4) update the pre-conversion restriction tracking field to null
  1. ..; 5) update the post-conversion restriction tracking field to null
  1. ..; 6) file the data into the file
  1. ..;
  1. ..S VBECB4=$P(^VBEC(6009,GG,0),U,2) ;(1)
  1. ..S $P(^DD(GG,0,"DI"),U,2)=VBECB4 ;(2)
  1. ..S:VBECB4="" VBECFDA(6009,GG_",",.02)="@" ;(3)
  1. ..S:VBECB4]"" VBECFDA(6009,GG_",",.02)=VBECB4 ;(4)
  1. ..S VBECFDA(6009,GG_",",.03)="@" ;(5)
  1. ..D FILE^DIE("","VBECFDA") ;(6)
  1. ..Q
  1. .K VBECB4,VBECFDA
  1. .Q
  1. D BMES^XPDUTL(VBECMSG)
  1. K GG,VBECMSG
  1. Q
  1. ;