MAGIP124 ;WOIFO/BT - INSTALL CODE FOR MAG*3.0*124 ; 11/07/12 10:01am
;;3.0;IMAGING;**124**;Mar 19, 2002;Build 143;Nov 14, 2012
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | 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. |
;; +---------------------------------------------------------------+
;;
;
; There are no environment checks here but the MAGIP124 has to be
; referenced by the "Environment Check Routine" field of the KIDS
; build so that entry points of the routine are available to the
; KIDS during all installation phases.
Q
;
;+++++ INSTALLATION ERROR HANDLING
ERROR ;
S:$D(XPDNM) XPDABORT=1
;--- Display the messages and store them to the INSTALL file
D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()
Q
;
;***** POST-INSTALL CODE
POS ;
N CALLBACK
D CLEAR^MAGUERR(1)
;
;Find VBAREASN in MAG REASON FILE
N REASNIEN S REASNIEN=$$FIND1^DIC(2005.88,,"BX",$$VBAREASN)
;
N OK
;If reason exists, update reason type if it doesn't have 'C' and/or 'P' access
I REASNIEN S OK=$$UPDREASN(REASNIEN)
;If reason doesn't exist, add reason
I 'REASNIEN S OK=$$ADDREASN
I 'OK D ERROR Q
;
;--- Send the notification e-mail
D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
Q
;
UPDREASN(REASNIEN) ;update reason type if it doesn't have 'C' and/or 'P' access
N REASNTYP S REASNTYP=$$GET1^DIQ(2005.88,REASNIEN_",",.02)
N TYPFOUND S TYPFOUND=(REASNTYP["P")&(REASNTYP["C")
Q:TYPFOUND 1 ;TYPE contains 'P' and 'C' already, no update requires
;
I REASNTYP'["P" S REASNTYP="P"_REASNTYP ;Add print image access
I REASNTYP'["C" S REASNTYP="C"_REASNTYP ;Add copy image access
;
N ERR,FDA
S FDA(2005.88,REASNIEN_",",.02)=REASNTYP ;update reason type
D FILE^DIE("","FDA","ERR")
Q '$D(ERR)
;
ADDREASN() ;add reason
N ERR,FDA,IENROOT
N REASON S REASON=$$VBAREASN
S FDA(2005.88,"+1,",.01)=REASON
S FDA(2005.88,"+1,",.02)="CP"
;use the last ien + 1 (potentially the next ien) for a place holder
;since field .04 (CODE) is a required field
S FDA(2005.88,"+1,",.04)=$P($G(^MAG(2005.88,0)),U,3)+1
D UPDATE^DIE("","FDA","IENROOT","ERR")
Q:$D(ERR) 0
K FDA
;
;Update field .04 with the IEN
S FDA(2005.88,IENROOT(1)_",",.04)=IENROOT(1)
D FILE^DIE("","FDA","ERR")
;
Q '$D(ERR)
;
VBAREASN() ;
Q "For use in Veterans Benefits Administration claims processing."
;
;***** PRE-INSTALL CODE
PRE ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP124 3278 printed Apr 09, 2024@21:06:34 Page 2
MAGIP124 ;WOIFO/BT - INSTALL CODE FOR MAG*3.0*124 ; 11/07/12 10:01am
+1 ;;3.0;IMAGING;**124**;Mar 19, 2002;Build 143;Nov 14, 2012
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
+18 ; There are no environment checks here but the MAGIP124 has to be
+19 ; referenced by the "Environment Check Routine" field of the KIDS
+20 ; build so that entry points of the routine are available to the
+21 ; KIDS during all installation phases.
+22 QUIT
+23 ;
+24 ;+++++ INSTALLATION ERROR HANDLING
ERROR ;
+1 if $DATA(XPDNM)
SET XPDABORT=1
+2 ;--- Display the messages and store them to the INSTALL file
+3 DO DUMP^MAGUERR1()
DO ABTMSG^MAGKIDS()
+4 QUIT
+5 ;
+6 ;***** POST-INSTALL CODE
POS ;
+1 NEW CALLBACK
+2 DO CLEAR^MAGUERR(1)
+3 ;
+4 ;Find VBAREASN in MAG REASON FILE
+5 NEW REASNIEN
SET REASNIEN=$$FIND1^DIC(2005.88,,"BX",$$VBAREASN)
+6 ;
+7 NEW OK
+8 ;If reason exists, update reason type if it doesn't have 'C' and/or 'P' access
+9 IF REASNIEN
SET OK=$$UPDREASN(REASNIEN)
+10 ;If reason doesn't exist, add reason
+11 IF 'REASNIEN
SET OK=$$ADDREASN
+12 IF 'OK
DO ERROR
QUIT
+13 ;
+14 ;--- Send the notification e-mail
+15 DO BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
+16 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+17 QUIT
+18 ;
UPDREASN(REASNIEN) ;update reason type if it doesn't have 'C' and/or 'P' access
+1 NEW REASNTYP
SET REASNTYP=$$GET1^DIQ(2005.88,REASNIEN_",",.02)
+2 NEW TYPFOUND
SET TYPFOUND=(REASNTYP["P")&(REASNTYP["C")
+3 ;TYPE contains 'P' and 'C' already, no update requires
if TYPFOUND
QUIT 1
+4 ;
+5 ;Add print image access
IF REASNTYP'["P"
SET REASNTYP="P"_REASNTYP
+6 ;Add copy image access
IF REASNTYP'["C"
SET REASNTYP="C"_REASNTYP
+7 ;
+8 NEW ERR,FDA
+9 ;update reason type
SET FDA(2005.88,REASNIEN_",",.02)=REASNTYP
+10 DO FILE^DIE("","FDA","ERR")
+11 QUIT '$DATA(ERR)
+12 ;
ADDREASN() ;add reason
+1 NEW ERR,FDA,IENROOT
+2 NEW REASON
SET REASON=$$VBAREASN
+3 SET FDA(2005.88,"+1,",.01)=REASON
+4 SET FDA(2005.88,"+1,",.02)="CP"
+5 ;use the last ien + 1 (potentially the next ien) for a place holder
+6 ;since field .04 (CODE) is a required field
+7 SET FDA(2005.88,"+1,",.04)=$PIECE($GET(^MAG(2005.88,0)),U,3)+1
+8 DO UPDATE^DIE("","FDA","IENROOT","ERR")
+9 if $DATA(ERR)
QUIT 0
+10 KILL FDA
+11 ;
+12 ;Update field .04 with the IEN
+13 SET FDA(2005.88,IENROOT(1)_",",.04)=IENROOT(1)
+14 DO FILE^DIE("","FDA","ERR")
+15 ;
+16 QUIT '$DATA(ERR)
+17 ;
VBAREASN() ;
+1 QUIT "For use in Veterans Benefits Administration claims processing."
+2 ;
+3 ;***** PRE-INSTALL CODE
PRE ;
+1 QUIT
