source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUOPT6.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1HLUOPT6 ;CIOFO-O/LJA - Fix zero node of file 772 or 773 ;02/04/2004 09:02
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4 QUIT
5 ;
6 ; This utility queues a background job to recalculate and reset
7 ; pieces 3 (last IEN) and 4 (# entries) in the zero nodes for
8 ; the HL Message Text file (#772) and the HL Message Administration
9 ; file (#773).
10 ;
11FIXZERO ; Reset piece 3 & 4 of zero node of file 772 &/or 773...
12 N FILE,GBL,IOINHI,IOINORM,LIST,X,Y
13 D HD
14 D EX
15 S X="IOINHI;IOINORM" D ENDR^%ZISS
16 W !!,?3,IOINHI,"Note:",IOINORM," ",IOINHI
17 W "This utility should be run when no purge processes are running.",IOINORM
18 ;
19 F Q:($Y+4)>IOSL W !
20 QUIT:'$$BTE("Press RETURN to continue, or '^' to exit... ") ;->
21 ;
22 D HD
23 ;
24 D FILE(.LIST) QUIT:'$D(LIST) ;->
25 W !!,"The process which fixes the zero node will now be queued to a background job."
26 W !,"When complete, a verification Mailman message will be sent to you on this"
27 W !,"system."
28 S X=$$BTE("Press RETURN to queue job, or '^' to exit... ",1) I 'X D QUIT ;->
29 . W " exiting... "
30 D ZTSK
31 S X=$$BTE("Press RETURN to exit... ",1)
32 Q
33 ;
34ZTSK ;
35 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
36 S ZTIO="",ZTDTH=$H,ZTDESC="HL7 Zero Node Correction"
37 S ZTRTN="QUEUE^HLUOPT6"
38 S ZTSAVE("LIST(")=""
39 D ^%ZTLOAD
40 W !!,"Queued to task# ",ZTSK,"..."
41 QUIT
42 ;
43QUEUE ;
44 N FILE,ZERO
45 S FILE=0
46 F S FILE=$O(LIST(FILE)) Q:FILE'>0 D
47 . D CORR(+FILE,.ZERO)
48 D MAIL
49 Q
50 ;
51CORR(FILE,ZERO) ; Correct zero node for file...
52 ; NOTE: No purging actions should be occurring now...
53 N CT,GBL,GBL0,IEN,LAST,NEW0
54 ;
55 S GBL=$S(FILE=772:"^HL(772)",1:"^HLMA")
56 S GBL0=$S(FILE=772:"^HL(772,0)",1:"^HLMA(0)")
57 S ZERO(1,FILE)=@GBL0
58 ;
59 S CT=0,IEN=0,LAST=""
60 F S IEN=$O(@GBL@(IEN)) Q:'IEN D
61 . QUIT:$P($G(@GBL@(+IEN,0)),U)']"" ;->
62 . S CT=CT+1,LAST=IEN
63 ;
64 S (NEW0,ZERO(2,FILE))=$P(ZERO(1,FILE),U,1,2)_U_LAST_U_CT
65 ;
66 I FILE=772 D
67 . L +^HL(772,0):30 ; Reset zero node even if fail...
68 . S ^HL(772,0)=NEW0
69 . L -^HL(772,0)
70 ;
71 I FILE=773 D
72 . L +^HLMA(0):30
73 . S ^HLMA(0)=NEW0
74 . L -^HLMA(0)
75 ;
76 Q
77 ;
78MAIL ; Send Mailman message.
79 N NO,TEXT,XMDUZ,XMSUB,XMTEXT,XMZ
80 S XMDUZ=.5,XMSUB="HL7 Zero Node Correction"
81 S XMTEXT="^TMP("_$J_",""HLMAILMSG"","
82 KILL ^TMP($J,"HLMAILMSG")
83 S NO=0
84 D MSGBODY
85 S XMY(DUZ)=""
86 D ^XMD
87 KILL ^TMP($J,"HLMAILMSG")
88 QUIT
89 ;
90MSGBODY ; Add message bode...
91 ; LIST,ZERO -- req
92 N CT,FILE
93 S CT=-1,FILE=0 F S FILE=$O(LIST(FILE)) Q:'FILE S CT=CT+1
94 D MAILADD("The zero node for file"_$S(CT:"s 772 & 773 have",1:" "_$O(LIST(0))_" has")_" now been reset.")
95 S FILE=0
96 F S FILE=$O(LIST(FILE)) Q:'FILE D
97 . D MAILADD("")
98 . D MAILADD("File "_FILE_" zero node reset from... "_$G(ZERO(1,FILE)))
99 . D MAILADD(" to... "_$G(ZERO(2,FILE)))
100 Q
101 ;
102MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T
103 QUIT
104 ;
105BTE(PMT,FF) ;
106 N DIR,DIRUT,DTOUT,DUOUT,X,Y
107 F X=1:1:$G(FF) W !
108 S DIR(0)="EA",DIR("A")=$G(PMT)
109 D ^DIR
110 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
111 Q $S(+Y=1:1,1:"")
112 ;
113FILE(LIST) ; Ask which files to correct..
114 ; IOINHI,IOINORM -- req
115 N DIR,DIRUT,DTOUT,DUOUT,TXT,X,Y
116 KILL LIST
117 W !!,"Select the file(s) now whose zero nodes should be corrected."
118 W !!,?10,$$CJ^XLFSTR("Zero Node Current Value",60)
119 W !,?10,$$REPEAT^XLFSTR("-",60)
120 W !,?13,"^HL(772,0) = "
121 D SH0($G(^HL(772,0)))
122 W !,?13,"^HLMA(0) = "
123 D SH0($G(^HLMA(0)))
124 W !
125 S DIR(0)="S^1:Correct file 772;2:Correct file 773;3:Correct both file 772 & 773"
126 S DIR("A")="Select file(s) to correct"
127 D ^DIR
128 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(+Y'>0) ;->
129 S:+Y=1 LIST(772)=""
130 S:+Y=2 LIST(773)=""
131 I +Y=3 S LIST(772)="",LIST(773)=""
132 Q
133 ;
134SH0(TXT) ; Highlight 3rd and 4th pieces...
135 ; IOINHI,IOINORM -- req
136 N PCE,VAL
137 W $P(TXT,U,1,2),U,IOINHI,$P(TXT,U,3),IOINORM,U,IOINHI,$P(TXT,U,4),IOINORM
138 Q
139 ;
140HD W @IOF,$$CJ^XLFSTR("File 772/773 Header Correction",IOM)
141 W !,$$REPEAT^XLFSTR("=",IOM)
142 QUIT
143 ;
144EX N I,T F I=1:1 S T=$T(EX+I) QUIT:T'[";;" W !,$P(T,";;",2,99)
145 ;;This utility corrects the zero node of the HL Message Text file (#772) and the
146 ;;HL Message Administration file (#773.) The following corrections will be made:
147 ;;
148 ;; - The last internal entry number will be found and set into piece 3 of the
149 ;; file's zero node.
150 ;;
151 ;; - The number of entries in the file being corrected will be recalculated and
152 ;; set into piece 4 of that file's zero node.
153 ;;
154 ;;You may specify one or both of these files to be corrected.
155 ;;
156 ;;These files are corrected by a queued background job. When the job completes,
157 ;;you will be notified by email message.
158 QUIT
159 ;
160EOR ; HLUOPT6 - Fix zero node of file 772 or 773 ;5/12/03 09:02
Note: See TracBrowser for help on using the repository browser.