| 1 | HLUOPT6 ;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 | ;
|
---|
| 11 | FIXZERO ; 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 | ;
|
---|
| 34 | ZTSK ;
|
---|
| 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 | ;
|
---|
| 43 | QUEUE ;
|
---|
| 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 | ;
|
---|
| 51 | CORR(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 | ;
|
---|
| 78 | MAIL ; 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 | ;
|
---|
| 90 | MSGBODY ; 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 | ;
|
---|
| 102 | MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T
|
---|
| 103 | QUIT
|
---|
| 104 | ;
|
---|
| 105 | BTE(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 | ;
|
---|
| 113 | FILE(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 | ;
|
---|
| 134 | SH0(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 | ;
|
---|
| 140 | HD W @IOF,$$CJ^XLFSTR("File 772/773 Header Correction",IOM)
|
---|
| 141 | W !,$$REPEAT^XLFSTR("=",IOM)
|
---|
| 142 | QUIT
|
---|
| 143 | ;
|
---|
| 144 | EX 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 | ;
|
---|
| 160 | EOR ; HLUOPT6 - Fix zero node of file 772 or 773 ;5/12/03 09:02
|
---|