- 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 Feb 18, 2025@23:37:17 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 ;