| 1 | MAGXIDXU ;WOIFO/JSL - MAG INDEX TERMS BUILD/UPDATE Utilities for Imaging Version 3.0
|
---|
| 2 | ;;3.0;IMAGING;**61**;Feb 07, 2006
|
---|
| 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 | ;; | |
|
---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
---|
| 12 | ;; | a medical device. As such, it may not be changed |
|
---|
| 13 | ;; | in any way. Modifications to this software may result in an |
|
---|
| 14 | ;; | adulterated medical device under 21CFR820, the use of which |
|
---|
| 15 | ;; | is considered to be a violation of US Federal Statutes. |
|
---|
| 16 | ;; +---------------------------------------------------------------+
|
---|
| 17 | Q
|
---|
| 18 | IDXUPDT ;API call - OPTION (MAG IMAGE INDEX TERMS UPDATE)
|
---|
| 19 | N DATE,IDA,SUB,XP,EOF,IN,MAGMSG,INXMB,LINE,LN,NEWSN,START,TKID,X,Y,XMZ,XMER,DIR
|
---|
| 20 | D GETENV^%ZOSV,KILL^XM
|
---|
| 21 | I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
|
---|
| 22 | 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
|
---|
| 23 | S SUB="MAG INDEX TERMS UPDATE" K ^TMP(SUB,$J)
|
---|
| 24 | S TKID=$H*86400+$P($H,",",2)
|
---|
| 25 | S X="ERR^MAGXIDXU",@^%ZOSF("TRAP")
|
---|
| 26 | L +^XTMP(SUB):5 I '$T U IO(0) W !,"Some one is also updating Index Terms, ^XTMP("_SUB_") locked." H 5 Q
|
---|
| 27 | S INXMB=$$INXMB^MAGXIDX0 I 'INXMB U IO(0) W !,"No updated distribution." H 2 Q ;latest idx update
|
---|
| 28 | U IO(0) W !
|
---|
| 29 | ;;IA 1048 - $$READ^XMGAPI1 Get the next line of XMZ message text.
|
---|
| 30 | S XMZ=INXMB F LN=1:1:256 S LINE=$$READ^XMGAPI1() Q:XMER=-1 I LINE[SUB Q
|
---|
| 31 | S LINE=$$READ^XMGAPI1() Q:XMER=-1 Q:LINE="" S NEWSN=+$P(LINE,"SERIAL#",2) ;new serial#
|
---|
| 32 | I +$G(^MAG(2005.82,"SERIAL#"))'<NEWSN U IO(0) W !,"The version is up-to-date." Q
|
---|
| 33 | F LN=1:1 S LINE=$$READ^XMGAPI1() Q:XMER=-1 S ^TMP(SUB,$J,LN)=LINE
|
---|
| 34 | I +$G(^MAG(2005.82,"SERIAL#"))<NEWSN D:$$PRECHK()
|
---|
| 35 | . S START=$$NOW^XLFDT
|
---|
| 36 | . F IN=2005.82,2005.83,2005.84,2005.85 I $D(^MAG(IN)) D
|
---|
| 37 | . . M ^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)=^MAG(IN)
|
---|
| 38 | . . Q
|
---|
| 39 | . D UPDATE I $G(EOF)'=1 D UFAIL U IO(0) D Q
|
---|
| 40 | . . W !,"The Update of Imaging Index Terms was Aborted.",!
|
---|
| 41 | . . W "The entire Distribution Mail Message was not received at this Site.",!
|
---|
| 42 | . . W "You need to call Imaging Support and have the Distribution Message Re-Sent to this site.",!
|
---|
| 43 | . . Q
|
---|
| 44 | . D INS("MAG INDEX TERMS UPDATE ",DUZ,START,""),MKBASE
|
---|
| 45 | . Q
|
---|
| 46 | L -^XTMP(SUB)
|
---|
| 47 | Q
|
---|
| 48 | ERR ;error handler
|
---|
| 49 | Q:'$G(DUZ)
|
---|
| 50 | I $G(TKID) I $D(^XTMP("MAG INDEX TERMS BACKUP",TKID)) D RECOVER
|
---|
| 51 | D @^%ZOSF("ERRTN")
|
---|
| 52 | Q
|
---|
| 53 | UPDATE ;called by IDXUPDT
|
---|
| 54 | NEW LN,MSG,Y,Y1,SCODE,SAVMAG,X,X1,X2
|
---|
| 55 | S LN=0 F S LN=$O(^TMP(SUB,$J,LN)) Q:'LN!$G(EOF) S Y=$G(^(LN)) DO
|
---|
| 56 | . I Y["Total Count:= " S EOF=1 U IO(0) W ! Q ;EOF mark
|
---|
| 57 | . I Y["INDEX TABLE GLOBAL"&(Y["MAG") D
|
---|
| 58 | . . S SCODE="S ^TMP("""_SUB_""","_$J_",0,"_$P(Y,"^MAG(",2)_"="
|
---|
| 59 | . . S LN=$O(^TMP(SUB,$J,LN)) Q:'LN S Y1=$G(^(LN))
|
---|
| 60 | . . S SCODE=SCODE_""""_Y1_""""
|
---|
| 61 | . . X SCODE U IO(0) W "*"
|
---|
| 62 | . . Q
|
---|
| 63 | . Q
|
---|
| 64 | 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
|
---|
| 65 | . W !,$P(^MAG(IN,0),"^"),"(#",IN,") ...updated.",!
|
---|
| 66 | . D CHKSTA
|
---|
| 67 | . K ^MAG(IN) M ^MAG(IN)=^TMP(SUB,$J,0,IN) ;set value
|
---|
| 68 | . S ^MAG(IN,"SERIAL#")=NEWSN
|
---|
| 69 | . Q
|
---|
| 70 | D NOW^%DTC S (Y,X1)=X,X2=7 D C^%DTC S ^XTMP("MAG INDEX TERMS BACKUP",0)=X_U_Y_U_SUB
|
---|
| 71 | Q
|
---|
| 72 | CHKSTA ;verify current status w/ National ^TMP
|
---|
| 73 | N IEN,STA,STO S IEN=0
|
---|
| 74 | I IN=2005.84 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
|
---|
| 75 | . S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,4),STO=$P($G(^MAG(IN,IEN,0)),U,4)
|
---|
| 76 | . I STA="I" Q ;disable by national
|
---|
| 77 | . I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,4)=STO Q ;kp site
|
---|
| 78 | . Q
|
---|
| 79 | I IN=2005.85 F S IEN=$O(^TMP(SUB,$J,0,IN,IEN)) Q:'IEN D
|
---|
| 80 | . S STA=$P(^TMP(SUB,$J,0,IN,IEN,0),U,3),STO=$P($G(^MAG(IN,IEN,0)),U,3)
|
---|
| 81 | . I STA="I" Q ;disable by national
|
---|
| 82 | . I STO="I" S $P(^TMP(SUB,$J,0,IN,IEN,0),U,3)=STO Q ;kp site
|
---|
| 83 | . Q
|
---|
| 84 | Q
|
---|
| 85 | UFAIL ;UPDATE FAIL, no End Of File
|
---|
| 86 | N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
|
---|
| 87 | D GETENV^%ZOSV
|
---|
| 88 | S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE FAILED"
|
---|
| 89 | S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
|
---|
| 90 | S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
|
---|
| 91 | S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
|
---|
| 92 | S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
|
---|
| 93 | S CNT=CNT+1,MAGMSG(CNT)="Did not receive whole package, there was no EOF mark"
|
---|
| 94 | S CNT=CNT+1,MAGMSG(CNT)="Please re-send new Index Terms message."
|
---|
| 95 | S XMSUB="MAG INDEX TERMS UPDATE #"_NEWSN_" Failed!"
|
---|
| 96 | S XMID=+$G(DUZ),XMY(XMID)=""
|
---|
| 97 | S XMY("G.MAG SERVER")=""
|
---|
| 98 | S:$G(MAGDUZ) XMY(MAGDUZ)=""
|
---|
| 99 | D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
|
---|
| 100 | D RECOVER
|
---|
| 101 | Q
|
---|
| 102 | INS(XP,DUZ,DATE,IDA) ;return msg
|
---|
| 103 | N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY,XMSUB,XMERR
|
---|
| 104 | D GETENV^%ZOSV
|
---|
| 105 | S CNT=1,MAGMSG(CNT)="MAG INDEX TERMS Update is completed"
|
---|
| 106 | S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
|
---|
| 107 | S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XP
|
---|
| 108 | S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
|
---|
| 109 | S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(DATE)
|
---|
| 110 | S CT=$$NOW^XLFDT ;Time stamp
|
---|
| 111 | S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
|
---|
| 112 | S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,DATE,3)
|
---|
| 113 | S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
|
---|
| 114 | S CNT=CNT+1,MAGMSG(CNT)="Restore Code: "_TKID
|
---|
| 115 | S CNT=CNT+1,MAGMSG(CNT)="DATE: "_$$FMTE^XLFDT(DATE)
|
---|
| 116 | S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(200,DUZ,.01,"E")
|
---|
| 117 | S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_XP
|
---|
| 118 | S XMSUB=XP_"#"_NEWSN_" INSTALLATION"
|
---|
| 119 | S XMID=+$G(DUZ),XMY(XMID)=""
|
---|
| 120 | S XMY("G.MAG SERVER")=""
|
---|
| 121 | S:$G(MAGDUZ) XMY(MAGDUZ)=""
|
---|
| 122 | S XMSUB=$E(XMSUB,1,63)
|
---|
| 123 | D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
|
---|
| 124 | I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
|
---|
| 125 | Q
|
---|
| 126 | RESTORE ;API call - MAG INDXE TERM RESTORE
|
---|
| 127 | N ANS,IN,TKID,DIR,Y
|
---|
| 128 | D GETENV^%ZOSV
|
---|
| 129 | I '$D(^XUSEC("MAG SYSTEM",+$G(DUZ))) U IO(0) W !,"Calling user does not have security key MAG SYSTEM" Q
|
---|
| 130 | F IN=1:1:5 U IO(0) D Q:$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID)))!($G(TKID)="^")
|
---|
| 131 | . W !,"To UnDo the Index Term updates and restore this site's Index Term files you need"
|
---|
| 132 | . W !,"the Restore Code that was included in the last INDEX TERMS UPDATE #",$G(^MAG(2005.82,"SERIAL#"))
|
---|
| 133 | . W !,"INSTALLATION message.",!
|
---|
| 134 | . W ! R "Enter Restore Code: ",TKID:360 I $G(TKID)["?" W " Restore Code please!",! S TKID=-1 Q
|
---|
| 135 | . W:'$D(^XTMP("MAG INDEX TERMS BACKUP",+$G(TKID))) !!,"Incorrect Restore Code, cannot restore the Index Term files."
|
---|
| 136 | . Q
|
---|
| 137 | Q:'$G(TKID)
|
---|
| 138 | S DIR("A")="Continue to restore Index Terms",DIR("B")="N",DIR(0)="Y" D ^DIR
|
---|
| 139 | I '$G(Y) U IO(0) W !,"Nothing done.",! Q
|
---|
| 140 | D RECOVER,MKBASE
|
---|
| 141 | U IO(0) W !,"Done.",!
|
---|
| 142 | Q
|
---|
| 143 | RECOVER ;Call by RESTORE
|
---|
| 144 | Q:$G(TKID)=""
|
---|
| 145 | F IN=2005.82,2005.83,2005.84,2005.85 D
|
---|
| 146 | . I $D(^MAG(IN))&$D(^XTMP("MAG INDEX TERMS BACKUP",TKID,IN)) D
|
---|
| 147 | . . K ^MAG(IN) M ^MAG(IN)=^XTMP("MAG INDEX TERMS BACKUP",TKID,IN) ;recoverd
|
---|
| 148 | . Q
|
---|
| 149 | Q
|
---|
| 150 | MKBASE ;make last known base
|
---|
| 151 | N IN,SUBJ,X,X0,X1,X2 S SUBJ="MAG INDEX TERMS UPDATE"
|
---|
| 152 | F IN=2005.82,2005.83,2005.84,2005.85 M ^XTMP(SUBJ,0,"BASE",IN)=^MAG(IN)
|
---|
| 153 | D NOW^%DTC S (X0,X1)=X,X2=180 D C^%DTC S ^XTMP(SUBJ,0)=X_U_X0_U_SUBJ
|
---|
| 154 | S ^XTMP(SUBJ,0,"BASE")=X0+17000000 ;yyyymmdd.hhmmss
|
---|
| 155 | Q
|
---|
| 156 | PRECHK() ;check to see if should overwrite old
|
---|
| 157 | N X,Y,DIFF,DCNT S (DIFF,DCNT)=0
|
---|
| 158 | I '$D(^XTMP(SUB,0,"BASE")) Q 1 ;no base to check
|
---|
| 159 | F IN="^MAG(2005.82","^MAG(2005.83" D ;compare contain
|
---|
| 160 | . S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
|
---|
| 161 | . . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
|
---|
| 162 | . . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
|
---|
| 163 | . . I $TR(@(X),U)'=$TR($G(@Y),U) D
|
---|
| 164 | . . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
|
---|
| 165 | . . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
|
---|
| 166 | . . Q
|
---|
| 167 | . Q
|
---|
| 168 | F IN="^MAG(2005.84","^MAG(2005.85" D ;compare contain but STATUS
|
---|
| 169 | . S X=IN_")" F S X=$Q(@X) Q:X'[IN I X[",0)",$L(X,",")=3 D
|
---|
| 170 | . . S Y="^XTMP("""_SUB_""","_0_",""BASE"","_$P(X,"^MAG(",2)
|
---|
| 171 | . . I $TR(@(X),U)=$TR($G(@Y),U) Q
|
---|
| 172 | . . I $G(@Y)="" S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Addition: "_X_" := "_@X Q
|
---|
| 173 | . . I IN["2005.84" I $TR($P(@X,U,1,3),U)=$TR($P($G(@Y),U,1,3),U) Q
|
---|
| 174 | . . I $TR($P(@X,U,1,2),U)=$TR($P($G(@Y),U,1,2),U) Q
|
---|
| 175 | . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Changed : "_X_" := "_@X
|
---|
| 176 | . . S DCNT=DCNT+1,DIFF=1,DIFF(DCNT)="Expected value: "_$G(@Y)
|
---|
| 177 | . . Q
|
---|
| 178 | . Q
|
---|
| 179 | I DIFF S (DCNT,CNT)=0 D ;find/report the difference
|
---|
| 180 | . S CNT=CNT+1,MAGMSG(CNT)="MAG INDEX TERMS UPDATE - PRE_CHECK FAILED"
|
---|
| 181 | . S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
|
---|
| 182 | . S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: MAG INDEX TERMS UPDATE"
|
---|
| 183 | . S CNT=CNT+1,MAGMSG(CNT)="Distribution: "_$G(NEWSN)
|
---|
| 184 | . S CNT=CNT+1,MAGMSG(CNT)="Changes have been made to the Index Term files at your site."
|
---|
| 185 | . S CNT=CNT+1,MAGMSG(CNT)="You must remove local Changes to these files before update can continue."
|
---|
| 186 | . S CNT=CNT+1,MAGMSG(CNT)=" - - - - - "
|
---|
| 187 | . S CNT=CNT+1,MAGMSG(CNT)="The Changes/Additions found were:"
|
---|
| 188 | . F CNT=CNT:1 S DCNT=$O(DIFF(DCNT)) Q:'DCNT S MAGMSG(CNT+1)=DIFF(DCNT)
|
---|
| 189 | . S CNT=CNT+2 S MAGMSG(CNT)=" - - - - - "
|
---|
| 190 | . S CNT=CNT+1 S MAGMSG(CNT)="Log a Remedy Ticket with VistA Imaging Support for help"
|
---|
| 191 | . S XMSUB="MAG INDEX TERMS UPDATE #"_$G(NEWSN)_" update has Failed!"
|
---|
| 192 | . S XMID=+$G(DUZ),XMY(XMID)=""
|
---|
| 193 | . S XMY("G.MAG SERVER")=""
|
---|
| 194 | . S:$G(MAGDUZ) XMY(MAGDUZ)=""
|
---|
| 195 | . D WARNMSG^MAGXIDX0 F IN=1:1:CNT U IO(0) W !,$G(MAGMSG(IN)),!
|
---|
| 196 | . D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
|
---|
| 197 | . Q
|
---|
| 198 | Q $S(DIFF:0,1:1)
|
---|