MAGIP155 ;WOIFO/JSL - MAG INDEX TERMS UPDATE Utilities for Imaging 3.0; 09/15/2014 10:15
;;3.0;IMAGING;**155**;;Build 16
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
PRE ;PRECHECK
D GETENV^%ZOSV,KILL^XM ;Clean up
N DIR,SUB,TKID,X,Y
U IO(0) S DIR("A")="Update Imaging Index Terms with the latest Distribution (Y/N)",DIR("B")="Y",DIR(0)="Y"
D ^DIR I '$G(Y) S XPDABORT=1 Q ;User selected not to update
S SUB="MAG INDEX TERMS UPDATE" K ^TMP(SUB,$J)
S X="ERR^MAGIP144",@^%ZOSF("TRAP")
S TKID=$H*86400+$P($H,",",2) D MAKEBKUP(TKID) ;backup before loading M global
U IO(0) W !,"Restore Code: "_TKID,!
S ^TMP(SUB,$J,"TKID")=TKID
Q
MAKEBKUP(TKID) ;make last known backup
N IN,SUBJ,X,X0,X1
S SUBJ="MAG INDEX TERMS BACKUP" U IO(0) W !,"backup"
F IN=2005.82,2005.83,2005.84,2005.85 M ^XTMP(SUBJ,TKID,IN)=^MAG(IN) U IO(0) W "*"
S X0=$$NOW^XLFDT()\1,X=$$FMADD^XLFDT(X0,180),^XTMP(SUBJ,0)=X_U_X0_U_SUBJ ;keep 180 days
U IO(0) W ! M ^TMP(SUB,$J,0)=^XTMP(SUBJ,TKID)
Q
;
;;
POST ;POSTINSTALL
POS ;
N CT,CNT,COM,D,D0,D1,D2,DG,DIC,DICR,DIR,DIW,IN,MAGMSG,ST,SUB,TKID,XMID,XMY,XMZ,XMSUB,XMERR,Y
S SUB="MAG INDEX TERMS UPDATE" D CHKSTA ;Status active
S TKID=$G(^TMP(SUB,$J,"TKID"))
I $$ISIHS^MAGSPID() D ;IHS has different terms
. F IN=105,106,107,110 S:$D(^MAG(2005.83,IN,0)) $P(^(0),"^",3)="A"
. ;IHS active MARRIAGE LICENSE, BIRTH CERTIFICATE, CERTIFICATE OF INDIAN BLOOD, CCD-SUMMARY
. F IN=7,46,47,48,49,51,53,57,70,86,87,88,95,98,102,104,108 S:$D(^MAG(2005.83,IN,0)) $P(^(0),"^",3)="I"
. S ^MAG(2005.85,3,1,0)="^2005.852P^6^6",^MAG(2005.85,3,1,1,0)=2 ;EKG has more specialty
. S ^MAG(2005.85,3,1,2,0)=39,^MAG(2005.85,3,1,3,0)=1
. S ^MAG(2005.85,3,1,4,0)=87,^MAG(2005.85,3,1,5,0)=42
. S ^MAG(2005.85,3,1,6,0)=52,^MAG(2005.85,3,1,"B",1,3)=""
. S ^MAG(2005.85,3,1,"B",2,1)="",^MAG(2005.85,3,1,"B",39,2)=""
. S ^MAG(2005.85,3,1,"B",42,5)="",^MAG(2005.85,3,1,"B",52,6)=""
. S ^MAG(2005.85,3,1,"B",87,4)=""
. S ^MAG(2005.85,210,0)="STATE AUTHORIZED PORTABLE ORDERS^7^I" ;IHS has inactive SAPO
. Q
E D ;Send VA site feedback
. D GETENV^%ZOSV
. S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS Update is completed"
. S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
. S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_$G(XPDNM,"MAG*3.0*144")
. S CT=$$NOW^XLFDT ;Current Time stamp
. S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
. S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
. S CNT=CNT+1,MAGMSG(CNT)="Restore Code: "_TKID
. S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
. S XMSUB="MAG INDEX TERMS UPDATE INSTALLATION"
. S XMID=+$G(DUZ),XMY(XMID)=""
. S XMY("G.MAG SERVER")=""
. S:$G(MAGDUZ) XMY(MAGDUZ)=""
. S XMSUB=$E(XMSUB,1,63)
. D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
. I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
. Q
;
D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
K ^TMP(SUB,$J)
Q
;
ERR ;error handler
Q:'$G(DUZ)
I $G(TKID) I $D(^XTMP("MAG INDEX TERMS BACKUP",TKID)) D RECOVER
S XPDABORT=1
D @^%ZOSF("ERRTN")
Q
;
CHKSTA ;verify current site status w/ National
N IN,IEN,STA,STO S IEN=0 ;only 2 terms can inactive by local site
S IN=2005.84 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
. S STO=$P(^TMP(SUB,$J,0,IN,IEN,0),U,4),STA=$P($G(^MAG(IN,IEN,0)),U,4)
. I STA="I" Q ;Apply inactive by VA national
. I STO="I" S $P(^MAG(IN,IEN,0),U,4)=STO Q ;keep site Option
. Q
S IN=2005.85 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
. S STO=$P(^TMP(SUB,$J,0,IN,IEN,0),U,3),STA=$P($G(^MAG(IN,IEN,0)),U,3)
. I STA="I" Q ;Apply inactive by VA national
. I STO="I" S $P(^MAG(IN,IEN,0),U,3)=STO Q ;keep site Option
. Q
Q
;
RECOVER ;Call restore old value, in case of error
Q:$G(TKID)=""
N IN
F IN=2005.82,2005.83,2005.84,2005.85 D U IO(0) W ^MAG(IN,0),!
. I $D(^MAG(IN))&$D(^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)) D
. . K ^MAG(IN) M ^MAG(IN)=^XTMP("MAG INDEX TERMS BACKUP",TKID,IN) ;recoverd
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP155 5056 printed Sep 23, 2025@19:40:28 Page 2
MAGIP155 ;WOIFO/JSL - MAG INDEX TERMS UPDATE Utilities for Imaging 3.0; 09/15/2014 10:15
+1 ;;3.0;IMAGING;**155**;;Build 16
+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 QUIT
+18 ;
PRE ;PRECHECK
+1 ;Clean up
DO GETENV^%ZOSV
DO KILL^XM
+2 NEW DIR,SUB,TKID,X,Y
+3 USE IO(0)
SET DIR("A")="Update Imaging Index Terms with the latest Distribution (Y/N)"
SET DIR("B")="Y"
SET DIR(0)="Y"
+4 ;User selected not to update
DO ^DIR
IF '$GET(Y)
SET XPDABORT=1
QUIT
+5 SET SUB="MAG INDEX TERMS UPDATE"
KILL ^TMP(SUB,$JOB)
+6 SET X="ERR^MAGIP144"
SET @^%ZOSF("TRAP")
+7 ;backup before loading M global
SET TKID=$HOROLOG*86400+$PIECE($HOROLOG,",",2)
DO MAKEBKUP(TKID)
+8 USE IO(0)
WRITE !,"Restore Code: "_TKID,!
+9 SET ^TMP(SUB,$JOB,"TKID")=TKID
+10 QUIT
MAKEBKUP(TKID) ;make last known backup
+1 NEW IN,SUBJ,X,X0,X1
+2 SET SUBJ="MAG INDEX TERMS BACKUP"
USE IO(0)
WRITE !,"backup"
+3 FOR IN=2005.82,2005.83,2005.84,2005.85
MERGE ^XTMP(SUBJ,TKID,IN)=^MAG(IN)
USE IO(0)
WRITE "*"
+4 ;keep 180 days
SET X0=$$NOW^XLFDT()\1
SET X=$$FMADD^XLFDT(X0,180)
SET ^XTMP(SUBJ,0)=X_U_X0_U_SUBJ
+5 USE IO(0)
WRITE !
MERGE ^TMP(SUB,$JOB,0)=^XTMP(SUBJ,TKID)
+6 QUIT
+7 ;
+8 ;;
POST ;POSTINSTALL
POS ;
+1 NEW CT,CNT,COM,D,D0,D1,D2,DG,DIC,DICR,DIR,DIW,IN,MAGMSG,ST,SUB,TKID,XMID,XMY,XMZ,XMSUB,XMERR,Y
+2 ;Status active
SET SUB="MAG INDEX TERMS UPDATE"
DO CHKSTA
+3 SET TKID=$GET(^TMP(SUB,$JOB,"TKID"))
+4 ;IHS has different terms
IF $$ISIHS^MAGSPID()
Begin DoDot:1
+5 FOR IN=105,106,107,110
if $DATA(^MAG(2005.83,IN,0))
SET $PIECE(^(0),"^",3)="A"
+6 ;IHS active MARRIAGE LICENSE, BIRTH CERTIFICATE, CERTIFICATE OF INDIAN BLOOD, CCD-SUMMARY
+7 FOR IN=7,46,47,48,49,51,53,57,70,86,87,88,95,98,102,104,108
if $DATA(^MAG(2005.83,IN,0))
SET $PIECE(^(0),"^",3)="I"
+8 ;EKG has more specialty
SET ^MAG(2005.85,3,1,0)="^2005.852P^6^6"
SET ^MAG(2005.85,3,1,1,0)=2
+9 SET ^MAG(2005.85,3,1,2,0)=39
SET ^MAG(2005.85,3,1,3,0)=1
+10 SET ^MAG(2005.85,3,1,4,0)=87
SET ^MAG(2005.85,3,1,5,0)=42
+11 SET ^MAG(2005.85,3,1,6,0)=52
SET ^MAG(2005.85,3,1,"B",1,3)=""
+12 SET ^MAG(2005.85,3,1,"B",2,1)=""
SET ^MAG(2005.85,3,1,"B",39,2)=""
+13 SET ^MAG(2005.85,3,1,"B",42,5)=""
SET ^MAG(2005.85,3,1,"B",52,6)=""
+14 SET ^MAG(2005.85,3,1,"B",87,4)=""
+15 ;IHS has inactive SAPO
SET ^MAG(2005.85,210,0)="STATE AUTHORIZED PORTABLE ORDERS^7^I"
+16 QUIT
End DoDot:1
+17 ;Send VA site feedback
IF '$TEST
Begin DoDot:1
+18 DO GETENV^%ZOSV
+19 SET CNT=1
SET MAGMSG(CNT)="MAG INDEX TERMS Update is completed"
+20 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+21 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_$GET(XPDNM,"MAG*3.0*144")
+22 ;Current Time stamp
SET CT=$$NOW^XLFDT
+23 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+24 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+25 SET CNT=CNT+1
SET MAGMSG(CNT)="Restore Code: "_TKID
+26 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
+27 SET XMSUB="MAG INDEX TERMS UPDATE INSTALLATION"
+28 SET XMID=+$GET(DUZ)
SET XMY(XMID)=""
+29 SET XMY("G.MAG SERVER")=""
+30 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+31 SET XMSUB=$EXTRACT(XMSUB,1,63)
+32 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+33 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+34 QUIT
End DoDot:1
+35 ;
+36 DO BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT))
+37 DO INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA)
+38 KILL ^TMP(SUB,$JOB)
+39 QUIT
+40 ;
ERR ;error handler
+1 if '$GET(DUZ)
QUIT
+2 IF $GET(TKID)
IF $DATA(^XTMP("MAG INDEX TERMS BACKUP",TKID))
DO RECOVER
+3 SET XPDABORT=1
+4 DO @^%ZOSF("ERRTN")
+5 QUIT
+6 ;
CHKSTA ;verify current site status w/ National
+1 ;only 2 terms can inactive by local site
NEW IN,IEN,STA,STO
SET IEN=0
+2 SET IN=2005.84
FOR
SET IEN=$ORDER(^TMP(SUB,$JOB,0,IN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET STO=$PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,4)
SET STA=$PIECE($GET(^MAG(IN,IEN,0)),U,4)
+4 ;Apply inactive by VA national
IF STA="I"
QUIT
+5 ;keep site Option
IF STO="I"
SET $PIECE(^MAG(IN,IEN,0),U,4)=STO
QUIT
+6 QUIT
End DoDot:1
+7 SET IN=2005.85
FOR
SET IEN=$ORDER(^TMP(SUB,$JOB,0,IN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 SET STO=$PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,3)
SET STA=$PIECE($GET(^MAG(IN,IEN,0)),U,3)
+9 ;Apply inactive by VA national
IF STA="I"
QUIT
+10 ;keep site Option
IF STO="I"
SET $PIECE(^MAG(IN,IEN,0),U,3)=STO
QUIT
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
RECOVER ;Call restore old value, in case of error
+1 if $GET(TKID)=""
QUIT
+2 NEW IN
+3 FOR IN=2005.82,2005.83,2005.84,2005.85
Begin DoDot:1
+4 IF $DATA(^MAG(IN))&$DATA(^XTMP("MAG INDEX TERMS BACKUP",TKID,IN))
Begin DoDot:2
+5 ;recoverd
KILL ^MAG(IN)
MERGE ^MAG(IN)=^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)
End DoDot:2
+6 QUIT
End DoDot:1
USE IO(0)
WRITE ^MAG(IN,0),!
+7 QUIT
+8 ;
