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

LR408.m

Go to the documentation of this file. 
  1. LR408 ;hoifo/rlm-Disable VistA Blood Bank options ;Nov 21, 2002
  1.  ;;5.2;LAB SERVICE;**408**;Sep 27, 1994;Build 8
  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 ;
  1.  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
  1.  S LRVBFLG=1,LRVBTXT="Options, files, and fields have been disabled at "_$P($$SITE^VASITE,"^",2)
  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(LRVBFLG=1:"out-of-order",1:"@")
  1.  .D OUT^XPDMENU(OPT,TXT)
  1.  .Q
  1.  K I,OPT,TXT
  1.  ; Note: Using Integration Agreement# 3805 to set and kill the
  1.  ; ^DD(file#,0,"DI") node.
  1.  ;
  1.  ;
  1.  S GG=0,U="^"  W !,"Finished disabling 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 LRVBIEN(1)=GG,LRVBIEN=HH,LRVBIENS=$$IENS^DILF(.LRVBIEN)
  1.  ...I LRVBFLG=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 LRVBNODE=$G(^VBEC(6009,GG,"DD",HH,0))
  1.  ....S LRVBFLD=$P(LRVBNODE,U,2),LRVBFLE=$P(LRVBNODE,U) ;(1)
  1.  ....S LRVBB4=$G(^DD(LRVBFLE,LRVBFLD,9))
  1.  ....S:LRVBB4]"" LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4 ;(2)
  1.  ....S VBECFDA(6009.01,LRVBIENS,2)="^" ;(3)
  1.  ....S ^DD(LRVBFLE,LRVBFLD,9)="^" ;(4)
  1.  ....D FILE^DIE("","LRVBFDA") ;(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 LRVBNODE=$G(^VBEC(6009,GG,"DD",HH,0))
  1.  ....S LRVBFLD=$P(LRVBNODE,U,2),LRVBFLE=$P(LRVBNODE,U) ;(1)
  1.  ....S LRVBB4=$G(^VBEC(6009,GG,"DD",HH,"PREW"))
  1.  ....S:LRVBB4="" LRVBFDA(6009.01,LRVBIENS,1)="@" ;(2A)
  1.  ....S:LRVBB4]"" LRVBFDA(6009.01,LRVBIENS,1)=LRVBB4 ;(2B)
  1.  ....S:LRVBB4]"" ^DD(LRVBFLE,LRVBFLD,9)=LRVBB4 ;(3)
  1.  ....K:LRVBB4="" ^DD(LRVBFLE,LRVBFLD,9) ;(4)
  1.  ....S LRVBFDA(6009.01,LRVBIENS,2)="@" ;(5)
  1.  ....D FILE^DIE("","LRVBFDA") ;(6)
  1.  ....Q
  1.  ...K LRVBB4,LRVBFDA,LRVBFLD,LRVBFLE,LRVBIENS,LRVBNODE
  1.  ...Q
  1.  ..K HH
  1.  ..Q
  1.  .;
  1.  .; whole file restriction check
  1.  .;
  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"))
  1.  ..S LRVBB4=$P($G(^DD(GG,0,"DI")),U,2) ;(1)
  1.  ..S:LRVBB4]"" LRVBFDA(6009,GG_",",.02)=LRVBB4 ;(1A)
  1.  ..S $P(^DD(GG,0,"DI"),U,2)="Y" ;(2)
  1.  ..S LRVBFDA(6009,GG_",",.03)="Y" ;(3)
  1.  ..D FILE^DIE("","LRVBFDA") ;(4)
  1.  ..Q
  1.  .K LRVBB4,LRVBFDA
  1.  .Q
  1.  K GG,LRVBMSG
  1. MSG ;Send a message showing success.
  1.  K ^TMP("VBEC",$J)
  1.  s ^TMP("VBEC",$J,1,0)=LRVBTXT
  1.  s XMSUB="LR*5.2*408 Patch Installation verification",XMTEXT="^TMP(""VBEC"",$J)",XMDUN="Vista BB Patch Monitor"
  1.  s XMY("G.VBEC@DOMAIN.EXT")=""
  1.  d SENDMSG^XMXAPI(DUZ,XMSUB,XMTEXT,.XMY)
  1.  k ^TMP("VBEC",$J),XMY
  1.  q  ;
  1. ZEOR ;LR408