MAGXIDXU ;WOIFO/JSL - MAG INDEX TERMS BUILD/UPDATE Utilities for Imaging Version 3.0; 06/29/2007 10:15
;;3.0;IMAGING;**61,54**;03-July-2009;;Build 1424
;; 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
;
IDXUPDT ;API call - OPTION (MAG IMAGE INDEX TERMS UPDATE)
N DATE,IDA,SUB,XP,EOF,IN,MAGMSG,INXMB,LINE,LN,NEWSN,START,TKID,X,Y,XMZ,XMER,DIR
D GETENV^%ZOSV,KILL^XM
I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
U IO(0) S DIR("A")="Update your local Index Terms with the latest Index Term Distribution (Y/N)",DIR("B")="Y",DIR(0)="Y" D ^DIR I '$G(Y) Q
S SUB="MAG INDEX TERMS UPDATE" K ^TMP(SUB,$J)
S TKID=$H*86400+$P($H,",",2)
S X="ERR^MAGXIDXU",@^%ZOSF("TRAP")
L +^XTMP(SUB):5 I '$T U IO(0) W !,"Some one is also updating Index Terms, ^XTMP("_SUB_") locked." H 5 Q
S INXMB=$$INXMB^MAGXIDX0 I 'INXMB U IO(0) W !,"No updated distribution." H 2 Q ;latest idx update
U IO(0) W !
;;IA 1048 - $$READ^XMGAPI1 Get the next line of XMZ message text.
S XMZ=INXMB F LN=1:1:256 S LINE=$$READ^XMGAPI1() Q:XMER=-1 I LINE[SUB Q
S LINE=$$READ^XMGAPI1() Q:XMER=-1 Q:LINE="" S NEWSN=+$P(LINE,"SERIAL#",2) ;new serial#
I +$G(^MAG(2005.82,"SERIAL#"))'<NEWSN U IO(0) W !,"The version is up-to-date." Q
F LN=1:1 S LINE=$$READ^XMGAPI1() Q:XMER=-1 S ^TMP(SUB,$J,LN)=LINE
I +$G(^MAG(2005.82,"SERIAL#"))<NEWSN D:$$PRECHK()
. S START=$$NOW^XLFDT
. F IN=2005.82,2005.83,2005.84,2005.85 I $D(^MAG(IN)) D
. . M ^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)=^MAG(IN)
. . Q
. D UPDATE I $G(EOF)'=1 D UFAIL U IO(0) D Q
. . W !,"The Update of Imaging Index Terms was Aborted.",!
. . W "The entire Distribution Mail Message was not received at this Site.",!
. . W "You need to call Imaging Support and have the Distribution Message Re-Sent to this site.",!
. . Q
. D INS("MAG INDEX TERMS UPDATE ",DUZ,START,""),MKBASE
. Q
L -^XTMP(SUB)
Q
ERR ;error handler
Q:'$G(DUZ)
I $G(TKID) I $D(^XTMP("MAG INDEX TERMS BACKUP",TKID)) D RECOVER
D @^%ZOSF("ERRTN")
Q
UPDATE ;called by IDXUPDT
NEW LN,MSG,Y,Y1,SCODE,SAVMAG,X
S LN=0 F S LN=$O(^TMP(SUB,$J,LN)) Q:'LN!$G(EOF) S Y=$G(^(LN)) DO
. I Y["Total Count:= " S EOF=1 U IO(0) W ! Q ;EOF mark
. I Y["INDEX TABLE GLOBAL"&(Y["MAG") D
. . S SCODE="S ^TMP("""_SUB_""","_$J_",0,"_$P(Y,"^MAG(",2)_"="
. . S LN=$O(^TMP(SUB,$J,LN)) Q:'LN S Y1=$G(^(LN))
. . S SCODE=SCODE_""""_Y1_""""
. . X SCODE U IO(0) W "*"
. . Q
. Q
I $G(EOF) U IO(0) W !,"Restore Code: "_TKID,! F IN=2005.82,2005.83,2005.84,2005.85 I $D(^TMP(SUB,$J,0,IN)) D
. W !,$P(^MAG(IN,0),"^"),"(#",IN,") ...updated.",!
. D CHKSTA
. K ^MAG(IN) M ^MAG(IN)=^TMP(SUB,$J,0,IN) ;set value
. S ^MAG(IN,"SERIAL#")=NEWSN
. Q
S Y=$$NOW^XLFDT()\1,X=$$FMADD^XLFDT(Y,7)
S ^XTMP("MAG INDEX TERMS BACKUP",0)=X_U_Y_U_SUB
Q
CHKSTA ;verify current status w/ National ^TMP
N IEN,STA,STO S IEN=0
I IN=2005.84 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
. S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,4),STO=$P($G(^MAG(IN,IEN,0)),U,4)
. I STA="I" Q ;disable by national
. I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,4)=STO Q ;kp site
. Q
I IN=2005.85 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
. S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,3),STO=$P($G(^MAG(IN,IEN,0)),U,3)
. I STA="I" Q ;disable by national
. I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,3)=STO Q ;kp site
. Q
Q
UFAIL ;UPDATE FAIL, no End Of File
N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
D GETENV^%ZOSV
S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE FAILED"
S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
S CNT=CNT+1,MAGMSG(CNT)="Did not receive whole package, there was no EOF mark"
S CNT=CNT+1,MAGMSG(CNT)="Please re-send new Index Terms message."
S XMSUB="MAG INDEX TERMS UPDATE #"_NEWSN_" Failed!"
S XMID=+$G(DUZ),XMY(XMID)=""
S XMY("G.MAG SERVER")=""
S:$G(MAGDUZ) XMY(MAGDUZ)=""
D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
D RECOVER
Q
INS(XP,DUZ,DATE,IDA) ;return msg
N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
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: "_XP
S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(DATE)
S CT=$$NOW^XLFDT ;Time stamp
S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,DATE,3)
S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
S CNT=CNT+1,MAGMSG(CNT)="Restore Code: "_TKID
S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$FMTE^XLFDT(DATE)
S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_XP
S XMSUB=XP_"#"_NEWSN_" 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
RESTORE ;API call - MAG INDXE TERM RESTORE
N ANS,IN,TKID,DIR,Y
D GETENV^%ZOSV
I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
F IN=1:1:5 U IO(0) D Q:$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID)))!($G(TKID)="^")
. W !,"To UnDo the Index Term updates and restore this site's Index Term files you need"
. W !,"the Restore Code that was included in the last INDEX TERMS UPDATE #",$G(^MAG(2005.82,"SERIAL#"))
. W !,"INSTALLATION message.",!
. W ! R "Enter Restore Code: ",TKID:360 I $G(TKID)["?" W " Restore Code please!",! S TKID=-1 Q
. W:'$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID))) !!,"Incorrect Restore Code, cannot restore the Index Term files."
. Q
Q:'$G(TKID)
S DIR("A")="Continue to restore Index Terms",DIR("B")="N",DIR(0)="Y" D ^DIR
I '$G(Y) U IO(0) W !,"Nothing done.",! Q
D RECOVER,MKBASE
U IO(0) W !,"Done.",!
Q
RECOVER ;Call by RESTORE
Q:$G(TKID)=""
F IN=2005.82,2005.83,2005.84,2005.85 D
. 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
MKBASE ;make last known base
N IN,SUBJ,X,X0,X1,X2 S SUBJ="MAG INDEX TERMS UPDATE"
F IN=2005.82,2005.83,2005.84,2005.85 M ^XTMP(SUBJ,0,"BASE",IN)=^MAG(IN)
S X0=$$NOW^XLFDT()\1,X=$$FMADD^XLFDT(X0,180),^XTMP(SUBJ,0)=X_U_X0_U_SUBJ
S ^XTMP(SUBJ,0,"BASE")=X0+17000000 ;yyyymmdd.hhmmss
Q
PRECHK() ;check to see if should overwrite old
N X,Y,DIFF,DCNT S (DIFF,DCNT)=0
I '$D(^XTMP(SUB,0,"BASE")) Q 1 ;no base to check
F IN="^MAG(2005.82","^MAG(2005.83" D ;compare contain
. S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
. . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
. . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
. . I $TR(@(X),U)'=$TR($G(@Y),U) D
. . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
. . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
. . Q
. Q
F IN="^MAG(2005.84","^MAG(2005.85" D ;compare contain but STATUS
. S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
. . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
. . I $TR(@(X),U)=$TR($G(@Y),U) Q
. . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
. . I IN["2005.84" I $TR($P(@X,U,1,3),U)=$TR($P($G(@Y),U,1,3),U) Q
. . I $TR($P(@X,U,1,2),U)=$TR($P($G(@Y),U,1,2),U) Q
. . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
. . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
. . Q
. Q
I DIFF S (DCNT,CNT)=0 D ;find/report the difference
. S CNT=CNT+1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE - PRE_CHECK FAILED"
. S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
. S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
. S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
. S CNT=CNT+1,MAGMSG(CNT)="Changes have been made to the Index Term files at your site."
. S CNT=CNT+1,MAGMSG(CNT)="You must remove local Changes to these files before update can continue."
. S CNT=CNT+1,MAGMSG(CNT)=" - - - - - "
. S CNT=CNT+1,MAGMSG(CNT)="The Changes/Additions found were:"
. F CNT=CNT:1 S DCNT=$O(DIFF(DCNT)) Q:'DCNT S MAGMSG(CNT+1)=DIFF(DCNT)
. S CNT=CNT+2 S MAGMSG(CNT)=" - - - - - "
. S CNT=CNT+1 S MAGMSG(CNT)="Log a Remedy Ticket with VistA Imaging Support for help"
. S XMSUB="MAG INDEX TERMS UPDATE #"_$G(NEWSN)_" update has Failed!"
. S XMID=+$G(DUZ),XMY(XMID)=""
. S XMY("G.MAG SERVER")=""
. S:$G(MAGDUZ) XMY(MAGDUZ)=""
. D WARNMSG^MAGXIDX0 F IN=1:1:CNT U IO(0) W !,$G(MAGMSG(IN)),!
. D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
. Q
Q $S(DIFF:0,1:1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGXIDXU 9987 printed Oct 16, 2024@18:11:27 Page 2
MAGXIDXU ;WOIFO/JSL - MAG INDEX TERMS BUILD/UPDATE Utilities for Imaging Version 3.0; 06/29/2007 10:15
+1 ;;3.0;IMAGING;**61,54**;03-July-2009;;Build 1424
+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 ;
IDXUPDT ;API call - OPTION (MAG IMAGE INDEX TERMS UPDATE)
+1 NEW DATE,IDA,SUB,XP,EOF,IN,MAGMSG,INXMB,LINE,LN,NEWSN,START,TKID,X,Y,XMZ,XMER,DIR
+2 DO GETENV^%ZOSV
DO KILL^XM
+3 IF '$DATA(^XUSEC("MAG SYSTEM",+$GET(DUZ)))
USE IO(0)
WRITE !,"Calling user does not have security key MAG SYSTEM"
QUIT
+4 USE IO(0)
SET DIR("A")="Update your local Index Terms with the latest Index Term Distribution (Y/N)"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
IF '$GET(Y)
QUIT
+5 SET SUB="MAG INDEX TERMS UPDATE"
KILL ^TMP(SUB,$JOB)
+6 SET TKID=$HOROLOG*86400+$PIECE($HOROLOG,",",2)
+7 SET X="ERR^MAGXIDXU"
SET @^%ZOSF("TRAP")
+8 LOCK +^XTMP(SUB):5
IF '$TEST
USE IO(0)
WRITE !,"Some one is also updating Index Terms, ^XTMP("_SUB_") locked."
HANG 5
QUIT
+9 ;latest idx update
SET INXMB=$$INXMB^MAGXIDX0
IF 'INXMB
USE IO(0)
WRITE !,"No updated distribution."
HANG 2
QUIT
+10 USE IO(0)
WRITE !
+11 ;;IA 1048 - $$READ^XMGAPI1 Get the next line of XMZ message text.
+12 SET XMZ=INXMB
FOR LN=1:1:256
SET LINE=$$READ^XMGAPI1()
if XMER=-1
QUIT
IF LINE[SUB
QUIT
+13 ;new serial#
SET LINE=$$READ^XMGAPI1()
if XMER=-1
QUIT
if LINE=""
QUIT
SET NEWSN=+$PIECE(LINE,"SERIAL#",2)
+14 IF +$GET(^MAG(2005.82,"SERIAL#"))'<NEWSN
USE IO(0)
WRITE !,"The version is up-to-date."
QUIT
+15 FOR LN=1:1
SET LINE=$$READ^XMGAPI1()
if XMER=-1
QUIT
SET ^TMP(SUB,$JOB,LN)=LINE
+16 IF +$GET(^MAG(2005.82,"SERIAL#"))<NEWSN
if $$PRECHK()
Begin DoDot:1
+17 SET START=$$NOW^XLFDT
+18 FOR IN=2005.82,2005.83,2005.84,2005.85
IF $DATA(^MAG(IN))
Begin DoDot:2
+19 MERGE ^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)=^MAG(IN)
+20 QUIT
End DoDot:2
+21 DO UPDATE
IF $GET(EOF)'=1
DO UFAIL
USE IO(0)
Begin DoDot:2
+22 WRITE !,"The Update of Imaging Index Terms was Aborted.",!
+23 WRITE "The entire Distribution Mail Message was not received at this Site.",!
+24 WRITE "You need to call Imaging Support and have the Distribution Message Re-Sent to this site.",!
+25 QUIT
End DoDot:2
QUIT
+26 DO INS("MAG INDEX TERMS UPDATE ",DUZ,START,"")
DO MKBASE
+27 QUIT
End DoDot:1
+28 LOCK -^XTMP(SUB)
+29 QUIT
ERR ;error handler
+1 if '$GET(DUZ)
QUIT
+2 IF $GET(TKID)
IF $DATA(^XTMP("MAG INDEX TERMS BACKUP",TKID))
DO RECOVER
+3 DO @^%ZOSF("ERRTN")
+4 QUIT
UPDATE ;called by IDXUPDT
+1 NEW LN,MSG,Y,Y1,SCODE,SAVMAG,X
+2 SET LN=0
FOR
SET LN=$ORDER(^TMP(SUB,$JOB,LN))
if 'LN!$GET(EOF)
QUIT
SET Y=$GET(^(LN))
Begin DoDot:1
+3 ;EOF mark
IF Y["Total Count:= "
SET EOF=1
USE IO(0)
WRITE !
QUIT
+4 IF Y["INDEX TABLE GLOBAL"&(Y["MAG")
Begin DoDot:2
+5 SET SCODE="S ^TMP("""_SUB_""","_$JOB_",0,"_$PIECE(Y,"^MAG(",2)_"="
+6 SET LN=$ORDER(^TMP(SUB,$JOB,LN))
if 'LN
QUIT
SET Y1=$GET(^(LN))
+7 SET SCODE=SCODE_""""_Y1_""""
+8 XECUTE SCODE
USE IO(0)
WRITE "*"
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 IF $GET(EOF)
USE IO(0)
WRITE !,"Restore Code: "_TKID,!
FOR IN=2005.82,2005.83,2005.84,2005.85
IF $DATA(^TMP(SUB,$JOB,0,IN))
Begin DoDot:1
+12 WRITE !,$PIECE(^MAG(IN,0),"^"),"(#",IN,") ...updated.",!
+13 DO CHKSTA
+14 ;set value
KILL ^MAG(IN)
MERGE ^MAG(IN)=^TMP(SUB,$JOB,0,IN)
+15 SET ^MAG(IN,"SERIAL#")=NEWSN
+16 QUIT
End DoDot:1
+17 SET Y=$$NOW^XLFDT()\1
SET X=$$FMADD^XLFDT(Y,7)
+18 SET ^XTMP("MAG INDEX TERMS BACKUP",0)=X_U_Y_U_SUB
+19 QUIT
CHKSTA ;verify current status w/ National ^TMP
+1 NEW IEN,STA,STO
SET IEN=0
+2 IF IN=2005.84
FOR
SET IEN=$ORDER(^TMP(SUB,$JOB,0,IN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET STA=$PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,4)
SET STO=$PIECE($GET(^MAG(IN,IEN,0)),U,4)
+4 ;disable by national
IF STA="I"
QUIT
+5 ;kp site
IF STO="I"
SET $PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,4)=STO
QUIT
+6 QUIT
End DoDot:1
+7 IF IN=2005.85
FOR
SET IEN=$ORDER(^TMP(SUB,$JOB,0,IN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 SET STA=$PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,3)
SET STO=$PIECE($GET(^MAG(IN,IEN,0)),U,3)
+9 ;disable by national
IF STA="I"
QUIT
+10 ;kp site
IF STO="I"
SET $PIECE(^TMP(SUB,$JOB,0,IN,IEN,0),U,3)=STO
QUIT
+11 QUIT
End DoDot:1
+12 QUIT
UFAIL ;UPDATE FAIL, no End Of File
+1 NEW CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
+2 DO GETENV^%ZOSV
+3 SET CNT=1
SET MAGMSG(CNT)="MAG INDEX TERMS UPDATE FAILED"
+4 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+5 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
+6 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution: "_$GET(NEWSN)
+7 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
+8 SET CNT=CNT+1
SET MAGMSG(CNT)="Did not receive whole package, there was no EOF mark"
+9 SET CNT=CNT+1
SET MAGMSG(CNT)="Please re-send new Index Terms message."
+10 SET XMSUB="MAG INDEX TERMS UPDATE #"_NEWSN_" Failed!"
+11 SET XMID=+$GET(DUZ)
SET XMY(XMID)=""
+12 SET XMY("G.MAG SERVER")=""
+13 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+14 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+15 DO RECOVER
+16 QUIT
INS(XP,DUZ,DATE,IDA) ;return msg
+1 NEW CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
+2 DO GETENV^%ZOSV
+3 SET CNT=1
SET MAGMSG(CNT)="MAG INDEX TERMS Update is completed"
+4 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+5 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: "_XP
+6 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution: "_$GET(NEWSN)
+7 SET CNT=CNT+1
SET MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(DATE)
+8 ;Time stamp
SET CT=$$NOW^XLFDT
+9 SET CNT=CNT+1
SET MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
+10 SET CNT=CNT+1
SET MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,DATE,3)
+11 SET CNT=CNT+1
SET MAGMSG(CNT)="Environment: "_Y
+12 SET CNT=CNT+1
SET MAGMSG(CNT)="Restore Code: "_TKID
+13 SET CNT=CNT+1
SET MAGMSG(CNT)="DATE: "_$$FMTE^XLFDT(DATE)
+14 SET CNT=CNT+1
SET MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
+15 SET CNT=CNT+1
SET MAGMSG(CNT)="Install Name: "_XP
+16 SET XMSUB=XP_"#"_NEWSN_" INSTALLATION"
+17 SET XMID=+$GET(DUZ)
SET XMY(XMID)=""
+18 SET XMY("G.MAG SERVER")=""
+19 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+20 SET XMSUB=$EXTRACT(XMSUB,1,63)
+21 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+22 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+23 QUIT
RESTORE ;API call - MAG INDXE TERM RESTORE
+1 NEW ANS,IN,TKID,DIR,Y
+2 DO GETENV^%ZOSV
+3 IF '$DATA(^XUSEC("MAG SYSTEM",+$GET(DUZ)))
USE IO(0)
WRITE !,"Calling user does not have security key MAG SYSTEM"
QUIT
+4 FOR IN=1:1:5
USE IO(0)
Begin DoDot:1
+5 WRITE !,"To UnDo the Index Term updates and restore this site's Index Term files you need"
+6 WRITE !,"the Restore Code that was included in the last INDEX TERMS UPDATE #",$GET(^MAG(2005.82,"SERIAL#"))
+7 WRITE !,"INSTALLATION message.",!
+8 WRITE !
READ "Enter Restore Code: ",TKID:360
IF $GET(TKID)["?"
WRITE " Restore Code please!",!
SET TKID=-1
QUIT
+9 if '$DATA(^XTMP("MAG INDEX TERMS BACKUP",+$GET(TKID)))
WRITE !!,"Incorrect Restore Code, cannot restore the Index Term files."
+10 QUIT
End DoDot:1
if $DATA(^XTMP("MAG INDEX TERMS BACKUP",+$GET(TKID)))!($GET(TKID)="^")
QUIT
+11 if '$GET(TKID)
QUIT
+12 SET DIR("A")="Continue to restore Index Terms"
SET DIR("B")="N"
SET DIR(0)="Y"
DO ^DIR
+13 IF '$GET(Y)
USE IO(0)
WRITE !,"Nothing done.",!
QUIT
+14 DO RECOVER
DO MKBASE
+15 USE IO(0)
WRITE !,"Done.",!
+16 QUIT
RECOVER ;Call by RESTORE
+1 if $GET(TKID)=""
QUIT
+2 FOR IN=2005.82,2005.83,2005.84,2005.85
Begin DoDot:1
+3 IF $DATA(^MAG(IN))&$DATA(^XTMP("MAG INDEX TERMS BACKUP",TKID,IN))
Begin DoDot:2
+4 ;recoverd
KILL ^MAG(IN)
MERGE ^MAG(IN)=^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)
End DoDot:2
+5 QUIT
End DoDot:1
+6 QUIT
MKBASE ;make last known base
+1 NEW IN,SUBJ,X,X0,X1,X2
SET SUBJ="MAG INDEX TERMS UPDATE"
+2 FOR IN=2005.82,2005.83,2005.84,2005.85
MERGE ^XTMP(SUBJ,0,"BASE",IN)=^MAG(IN)
+3 SET X0=$$NOW^XLFDT()\1
SET X=$$FMADD^XLFDT(X0,180)
SET ^XTMP(SUBJ,0)=X_U_X0_U_SUBJ
+4 ;yyyymmdd.hhmmss
SET ^XTMP(SUBJ,0,"BASE")=X0+17000000
+5 QUIT
PRECHK() ;check to see if should overwrite old
+1 NEW X,Y,DIFF,DCNT
SET (DIFF,DCNT)=0
+2 ;no base to check
IF '$DATA(^XTMP(SUB,0,"BASE"))
QUIT 1
+3 ;compare contain
FOR IN="^MAG(2005.82","^MAG(2005.83"
Begin DoDot:1
+4 SET X=IN_")"
FOR
SET X=$QUERY(@X)
if X'[IN
QUIT
IF X[",0)"
IF $LENGTH(X,",")=3
Begin DoDot:2
+5 SET Y="^XTMP("""_SUB_""","_0_",""BASE"","_$PIECE(X,"^MAG(",2)
+6 IF $GET(@Y)=""
SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Addition: "_X_" := "_@X
QUIT
+7 IF $TRANSLATE(@(X),U)'=$TRANSLATE($GET(@Y),U)
Begin DoDot:3
+8 SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Changed : "_X_" := "_@X
+9 SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Expected value: "_$GET(@Y)
End DoDot:3
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;compare contain but STATUS
FOR IN="^MAG(2005.84","^MAG(2005.85"
Begin DoDot:1
+13 SET X=IN_")"
FOR
SET X=$QUERY(@X)
if X'[IN
QUIT
IF X[",0)"
IF $LENGTH(X,",")=3
Begin DoDot:2
+14 SET Y="^XTMP("""_SUB_""","_0_",""BASE"","_$PIECE(X,"^MAG(",2)
+15 IF $TRANSLATE(@(X),U)=$TRANSLATE($GET(@Y),U)
QUIT
+16 IF $GET(@Y)=""
SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Addition: "_X_" := "_@X
QUIT
+17 IF IN["2005.84"
IF $TRANSLATE($PIECE(@X,U,1,3),U)=$TRANSLATE($PIECE($GET(@Y),U,1,3),U)
QUIT
+18 IF $TRANSLATE($PIECE(@X,U,1,2),U)=$TRANSLATE($PIECE($GET(@Y),U,1,2),U)
QUIT
+19 SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Changed : "_X_" := "_@X
+20 SET DCNT=DCNT+1
SET DIFF=1
SET DIFF(DCNT)="Expected value: "_$GET(@Y)
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 ;find/report the difference
IF DIFF
SET (DCNT,CNT)=0
Begin DoDot:1
+24 SET CNT=CNT+1
SET MAGMSG(CNT)="MAG INDEX TERMS UPDATE - PRE_CHECK FAILED"
+25 SET CNT=CNT+1
SET MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
+26 SET CNT=CNT+1
SET MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
+27 SET CNT=CNT+1
SET MAGMSG(CNT)="Distribution: "_$GET(NEWSN)
+28 SET CNT=CNT+1
SET MAGMSG(CNT)="Changes have been made to the Index Term files at your site."
+29 SET CNT=CNT+1
SET MAGMSG(CNT)="You must remove local Changes to these files before update can continue."
+30 SET CNT=CNT+1
SET MAGMSG(CNT)=" - - - - - "
+31 SET CNT=CNT+1
SET MAGMSG(CNT)="The Changes/Additions found were:"
+32 FOR CNT=CNT:1
SET DCNT=$ORDER(DIFF(DCNT))
if 'DCNT
QUIT
SET MAGMSG(CNT+1)=DIFF(DCNT)
+33 SET CNT=CNT+2
SET MAGMSG(CNT)=" - - - - - "
+34 SET CNT=CNT+1
SET MAGMSG(CNT)="Log a Remedy Ticket with VistA Imaging Support for help"
+35 SET XMSUB="MAG INDEX TERMS UPDATE #"_$GET(NEWSN)_" update has Failed!"
+36 SET XMID=+$GET(DUZ)
SET XMY(XMID)=""
+37 SET XMY("G.MAG SERVER")=""
+38 if $GET(MAGDUZ)
SET XMY(MAGDUZ)=""
+39 DO WARNMSG^MAGXIDX0
FOR IN=1:1:CNT
USE IO(0)
WRITE !,$GET(MAGMSG(IN)),!
+40 DO SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
+41 QUIT
End DoDot:1
+42 QUIT $SELECT(DIFF:0,1:1)
+43 ;
