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

MAGXIDXU.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. IDXUPDT ;API call - OPTION (MAG IMAGE INDEX TERMS UPDATE)
  1. N DATE,IDA,SUB,XP,EOF,IN,MAGMSG,INXMB,LINE,LN,NEWSN,START,TKID,X,Y,XMZ,XMER,DIR
  1. D GETENV^%ZOSV,KILL^XM
  1. I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
  1. 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
  1. S SUB="MAG INDEX TERMS UPDATE" K ^TMP(SUB,$J)
  1. S TKID=$H*86400+$P($H,",",2)
  1. S X="ERR^MAGXIDXU",@^%ZOSF("TRAP")
  1. L +^XTMP(SUB):5 I '$T U IO(0) W !,"Some one is also updating Index Terms, ^XTMP("_SUB_") locked." H 5 Q
  1. S INXMB=$$INXMB^MAGXIDX0 I 'INXMB U IO(0) W !,"No updated distribution." H 2 Q ;latest idx update
  1. U IO(0) W !
  1. ;;IA 1048 - $$READ^XMGAPI1 Get the next line of XMZ message text.
  1. S XMZ=INXMB F LN=1:1:256 S LINE=$$READ^XMGAPI1() Q:XMER=-1 I LINE[SUB Q
  1. S LINE=$$READ^XMGAPI1() Q:XMER=-1 Q:LINE="" S NEWSN=+$P(LINE,"SERIAL#",2) ;new serial#
  1. I +$G(^MAG(2005.82,"SERIAL#"))'<NEWSN U IO(0) W !,"The version is up-to-date." Q
  1. F LN=1:1 S LINE=$$READ^XMGAPI1() Q:XMER=-1 S ^TMP(SUB,$J,LN)=LINE
  1. I +$G(^MAG(2005.82,"SERIAL#"))<NEWSN D:$$PRECHK()
  1. . S START=$$NOW^XLFDT
  1. . F IN=2005.82,2005.83,2005.84,2005.85 I $D(^MAG(IN)) D
  1. . . M ^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)=^MAG(IN)
  1. . . Q
  1. . D UPDATE I $G(EOF)'=1 D UFAIL U IO(0) D Q
  1. . . W !,"The Update of Imaging Index Terms was Aborted.",!
  1. . . W "The entire Distribution Mail Message was not received at this Site.",!
  1. . . W "You need to call Imaging Support and have the Distribution Message Re-Sent to this site.",!
  1. . . Q
  1. . D INS("MAG INDEX TERMS UPDATE ",DUZ,START,""),MKBASE
  1. . Q
  1. L -^XTMP(SUB)
  1. Q
  1. ERR ;error handler
  1. Q:'$G(DUZ)
  1. I $G(TKID) I $D(^XTMP("MAG INDEX TERMS BACKUP",TKID)) D RECOVER
  1. D @^%ZOSF("ERRTN")
  1. Q
  1. UPDATE ;called by IDXUPDT
  1. NEW LN,MSG,Y,Y1,SCODE,SAVMAG,X
  1. S LN=0 F S LN=$O(^TMP(SUB,$J,LN)) Q:'LN!$G(EOF) S Y=$G(^(LN)) DO
  1. . I Y["Total Count:= " S EOF=1 U IO(0) W ! Q ;EOF mark
  1. . I Y["INDEX TABLE GLOBAL"&(Y["MAG") D
  1. . . S SCODE="S ^TMP("""_SUB_""","_$J_",0,"_$P(Y,"^MAG(",2)_"="
  1. . . S LN=$O(^TMP(SUB,$J,LN)) Q:'LN S Y1=$G(^(LN))
  1. . . S SCODE=SCODE_""""_Y1_""""
  1. . . X SCODE U IO(0) W "*"
  1. . . Q
  1. . Q
  1. 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
  1. . W !,$P(^MAG(IN,0),"^"),"(#",IN,") ...updated.",!
  1. . D CHKSTA
  1. . K ^MAG(IN) M ^MAG(IN)=^TMP(SUB,$J,0,IN) ;set value
  1. . S ^MAG(IN,"SERIAL#")=NEWSN
  1. . Q
  1. S Y=$$NOW^XLFDT()\1,X=$$FMADD^XLFDT(Y,7)
  1. S ^XTMP("MAG INDEX TERMS BACKUP",0)=X_U_Y_U_SUB
  1. Q
  1. CHKSTA ;verify current status w/ National ^TMP
  1. N IEN,STA,STO S IEN=0
  1. I IN=2005.84 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
  1. . S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,4),STO=$P($G(^MAG(IN,IEN,0)),U,4)
  1. . I STA="I" Q ;disable by national
  1. . I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,4)=STO Q ;kp site
  1. . Q
  1. I IN=2005.85 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
  1. . S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,3),STO=$P($G(^MAG(IN,IEN,0)),U,3)
  1. . I STA="I" Q ;disable by national
  1. . I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,3)=STO Q ;kp site
  1. . Q
  1. Q
  1. UFAIL ;UPDATE FAIL, no End Of File
  1. N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
  1. D GETENV^%ZOSV
  1. S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE FAILED"
  1. S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
  1. S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
  1. S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
  1. S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
  1. S CNT=CNT+1,MAGMSG(CNT)="Did not receive whole package, there was no EOF mark"
  1. S CNT=CNT+1,MAGMSG(CNT)="Please re-send new Index Terms message."
  1. S XMSUB="MAG INDEX TERMS UPDATE #"_NEWSN_" Failed!"
  1. S XMID=+$G(DUZ),XMY(XMID)=""
  1. S XMY("G.MAG SERVER")=""
  1. S:$G(MAGDUZ) XMY(MAGDUZ)=""
  1. D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
  1. D RECOVER
  1. Q
  1. INS(XP,DUZ,DATE,IDA) ;return msg
  1. N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
  1. D GETENV^%ZOSV
  1. S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS Update is completed"
  1. S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
  1. S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XP
  1. S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
  1. S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(DATE)
  1. S CT=$$NOW^XLFDT ;Time stamp
  1. S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
  1. S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,DATE,3)
  1. S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
  1. S CNT=CNT+1,MAGMSG(CNT)="Restore Code: "_TKID
  1. S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$FMTE^XLFDT(DATE)
  1. S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
  1. S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_XP
  1. S XMSUB=XP_"#"_NEWSN_" INSTALLATION"
  1. S XMID=+$G(DUZ),XMY(XMID)=""
  1. S XMY("G.MAG SERVER")=""
  1. S:$G(MAGDUZ) XMY(MAGDUZ)=""
  1. S XMSUB=$E(XMSUB,1,63)
  1. D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
  1. I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
  1. Q
  1. RESTORE ;API call - MAG INDXE TERM RESTORE
  1. N ANS,IN,TKID,DIR,Y
  1. D GETENV^%ZOSV
  1. I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
  1. F IN=1:1:5 U IO(0) D Q:$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID)))!($G(TKID)="^")
  1. . W !,"To UnDo the Index Term updates and restore this site's Index Term files you need"
  1. . W !,"the Restore Code that was included in the last INDEX TERMS UPDATE #",$G(^MAG(2005.82,"SERIAL#"))
  1. . W !,"INSTALLATION message.",!
  1. . W ! R "Enter Restore Code: ",TKID:360 I $G(TKID)["?" W " Restore Code please!",! S TKID=-1 Q
  1. . W:'$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID))) !!,"Incorrect Restore Code, cannot restore the Index Term files."
  1. . Q
  1. Q:'$G(TKID)
  1. S DIR("A")="Continue to restore Index Terms",DIR("B")="N",DIR(0)="Y" D ^DIR
  1. I '$G(Y) U IO(0) W !,"Nothing done.",! Q
  1. D RECOVER,MKBASE
  1. U IO(0) W !,"Done.",!
  1. Q
  1. RECOVER ;Call by RESTORE
  1. Q:$G(TKID)=""
  1. F IN=2005.82,2005.83,2005.84,2005.85 D
  1. . I $D(^MAG(IN))&$D(^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)) D
  1. . . K ^MAG(IN) M ^MAG(IN)=^XTMP("MAG INDEX TERMS BACKUP",TKID,IN) ;recoverd
  1. . Q
  1. Q
  1. MKBASE ;make last known base
  1. N IN,SUBJ,X,X0,X1,X2 S SUBJ="MAG INDEX TERMS UPDATE"
  1. F IN=2005.82,2005.83,2005.84,2005.85 M ^XTMP(SUBJ,0,"BASE",IN)=^MAG(IN)
  1. S X0=$$NOW^XLFDT()\1,X=$$FMADD^XLFDT(X0,180),^XTMP(SUBJ,0)=X_U_X0_U_SUBJ
  1. S ^XTMP(SUBJ,0,"BASE")=X0+17000000 ;yyyymmdd.hhmmss
  1. Q
  1. PRECHK() ;check to see if should overwrite old
  1. N X,Y,DIFF,DCNT S (DIFF,DCNT)=0
  1. I '$D(^XTMP(SUB,0,"BASE")) Q 1 ;no base to check
  1. F IN="^MAG(2005.82","^MAG(2005.83" D ;compare contain
  1. . S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
  1. . . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
  1. . . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
  1. . . I $TR(@(X),U)'=$TR($G(@Y),U) D
  1. . . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
  1. . . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
  1. . . Q
  1. . Q
  1. F IN="^MAG(2005.84","^MAG(2005.85" D ;compare contain but STATUS
  1. . S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
  1. . . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
  1. . . I $TR(@(X),U)=$TR($G(@Y),U) Q
  1. . . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
  1. . . I IN["2005.84" I $TR($P(@X,U,1,3),U)=$TR($P($G(@Y),U,1,3),U) Q
  1. . . I $TR($P(@X,U,1,2),U)=$TR($P($G(@Y),U,1,2),U) Q
  1. . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
  1. . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
  1. . . Q
  1. . Q
  1. I DIFF S (DCNT,CNT)=0 D ;find/report the difference
  1. . S CNT=CNT+1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE - PRE_CHECK FAILED"
  1. . S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
  1. . S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
  1. . S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
  1. . S CNT=CNT+1,MAGMSG(CNT)="Changes have been made to the Index Term files at your site."
  1. . S CNT=CNT+1,MAGMSG(CNT)="You must remove local Changes to these files before update can continue."
  1. . S CNT=CNT+1,MAGMSG(CNT)=" - - - - - "
  1. . S CNT=CNT+1,MAGMSG(CNT)="The Changes/Additions found were:"
  1. . F CNT=CNT:1 S DCNT=$O(DIFF(DCNT)) Q:'DCNT S MAGMSG(CNT+1)=DIFF(DCNT)
  1. . S CNT=CNT+2 S MAGMSG(CNT)=" - - - - - "
  1. . S CNT=CNT+1 S MAGMSG(CNT)="Log a Remedy Ticket with VistA Imaging Support for help"
  1. . S XMSUB="MAG INDEX TERMS UPDATE #"_$G(NEWSN)_" update has Failed!"
  1. . S XMID=+$G(DUZ),XMY(XMID)=""
  1. . S XMY("G.MAG SERVER")=""
  1. . S:$G(MAGDUZ) XMY(MAGDUZ)=""
  1. . D WARNMSG^MAGXIDX0 F IN=1:1:CNT U IO(0) W !,$G(MAGMSG(IN)),!
  1. . D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
  1. . Q
  1. Q $S(DIFF:0,1:1)
  1. ;