source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGXIDXU.m@ 972

Last change on this file since 972 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 9.5 KB
RevLine 
[613]1MAGXIDXU ;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
18IDXUPDT ;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
48ERR ;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
53UPDATE ;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
72CHKSTA ;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
85UFAIL ;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
102INS(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
126RESTORE ;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
143RECOVER ;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
150MKBASE ;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
156PRECHK() ;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)
Note: See TracBrowser for help on using the repository browser.