HLUOPT6 ;CIOFO-O/LJA - Fix zero node of file 772 or 773 ;02/04/2004 09:02
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
QUIT
;
; This utility queues a background job to recalculate and reset
; pieces 3 (last IEN) and 4 (# entries) in the zero nodes for
; the HL Message Text file (#772) and the HL Message Administration
; file (#773).
;
FIXZERO ; Reset piece 3 & 4 of zero node of file 772 &/or 773...
N FILE,GBL,IOINHI,IOINORM,LIST,X,Y
D HD
D EX
S X="IOINHI;IOINORM" D ENDR^%ZISS
W !!,?3,IOINHI,"Note:",IOINORM," ",IOINHI
W "This utility should be run when no purge processes are running.",IOINORM
;
F Q:($Y+4)>IOSL W !
QUIT:'$$BTE("Press RETURN to continue, or '^' to exit... ") ;->
;
D HD
;
D FILE(.LIST) QUIT:'$D(LIST) ;->
W !!,"The process which fixes the zero node will now be queued to a background job."
W !,"When complete, a verification Mailman message will be sent to you on this"
W !,"system."
S X=$$BTE("Press RETURN to queue job, or '^' to exit... ",1) I 'X D QUIT ;->
. W " exiting... "
D ZTSK
S X=$$BTE("Press RETURN to exit... ",1)
Q
;
ZTSK ;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
S ZTIO="",ZTDTH=$H,ZTDESC="HL7 Zero Node Correction"
S ZTRTN="QUEUE^HLUOPT6"
S ZTSAVE("LIST(")=""
D ^%ZTLOAD
W !!,"Queued to task# ",ZTSK,"..."
QUIT
;
QUEUE ;
N FILE,ZERO
S FILE=0
F S FILE=$O(LIST(FILE)) Q:FILE'>0 D
. D CORR(+FILE,.ZERO)
D MAIL
Q
;
CORR(FILE,ZERO) ; Correct zero node for file...
; NOTE: No purging actions should be occurring now...
N CT,GBL,GBL0,IEN,LAST,NEW0
;
S GBL=$S(FILE=772:"^HL(772)",1:"^HLMA")
S GBL0=$S(FILE=772:"^HL(772,0)",1:"^HLMA(0)")
S ZERO(1,FILE)=@GBL0
;
S CT=0,IEN=0,LAST=""
F S IEN=$O(@GBL@(IEN)) Q:'IEN D
. QUIT:$P($G(@GBL@(+IEN,0)),U)']"" ;->
. S CT=CT+1,LAST=IEN
;
S (NEW0,ZERO(2,FILE))=$P(ZERO(1,FILE),U,1,2)_U_LAST_U_CT
;
I FILE=772 D
. L +^HL(772,0):30 ; Reset zero node even if fail...
. S ^HL(772,0)=NEW0
. L -^HL(772,0)
;
I FILE=773 D
. L +^HLMA(0):30
. S ^HLMA(0)=NEW0
. L -^HLMA(0)
;
Q
;
MAIL ; Send Mailman message.
N NO,TEXT,XMDUZ,XMSUB,XMTEXT,XMZ
S XMDUZ=.5,XMSUB="HL7 Zero Node Correction"
S XMTEXT="^TMP("_$J_",""HLMAILMSG"","
KILL ^TMP($J,"HLMAILMSG")
S NO=0
D MSGBODY
S XMY(DUZ)=""
D ^XMD
KILL ^TMP($J,"HLMAILMSG")
QUIT
;
MSGBODY ; Add message bode...
; LIST,ZERO -- req
N CT,FILE
S CT=-1,FILE=0 F S FILE=$O(LIST(FILE)) Q:'FILE S CT=CT+1
D MAILADD("The zero node for file"_$S(CT:"s 772 & 773 have",1:" "_$O(LIST(0))_" has")_" now been reset.")
S FILE=0
F S FILE=$O(LIST(FILE)) Q:'FILE D
. D MAILADD("")
. D MAILADD("File "_FILE_" zero node reset from... "_$G(ZERO(1,FILE)))
. D MAILADD(" to... "_$G(ZERO(2,FILE)))
Q
;
MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T
QUIT
;
BTE(PMT,FF) ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
F X=1:1:$G(FF) W !
S DIR(0)="EA",DIR("A")=$G(PMT)
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
Q $S(+Y=1:1,1:"")
;
FILE(LIST) ; Ask which files to correct..
; IOINHI,IOINORM -- req
N DIR,DIRUT,DTOUT,DUOUT,TXT,X,Y
KILL LIST
W !!,"Select the file(s) now whose zero nodes should be corrected."
W !!,?10,$$CJ^XLFSTR("Zero Node Current Value",60)
W !,?10,$$REPEAT^XLFSTR("-",60)
W !,?13,"^HL(772,0) = "
D SH0($G(^HL(772,0)))
W !,?13,"^HLMA(0) = "
D SH0($G(^HLMA(0)))
W !
S DIR(0)="S^1:Correct file 772;2:Correct file 773;3:Correct both file 772 & 773"
S DIR("A")="Select file(s) to correct"
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(+Y'>0) ;->
S:+Y=1 LIST(772)=""
S:+Y=2 LIST(773)=""
I +Y=3 S LIST(772)="",LIST(773)=""
Q
;
SH0(TXT) ; Highlight 3rd and 4th pieces...
; IOINHI,IOINORM -- req
N PCE,VAL
W $P(TXT,U,1,2),U,IOINHI,$P(TXT,U,3),IOINORM,U,IOINHI,$P(TXT,U,4),IOINORM
Q
;
HD W @IOF,$$CJ^XLFSTR("File 772/773 Header Correction",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
QUIT
;
EX N I,T F I=1:1 S T=$T(EX+I) QUIT:T'[";;" W !,$P(T,";;",2,99)
;;This utility corrects the zero node of the HL Message Text file (#772) and the
;;HL Message Administration file (#773.) The following corrections will be made:
;;
;; - The last internal entry number will be found and set into piece 3 of the
;; file's zero node.
;;
;; - The number of entries in the file being corrected will be recalculated and
;; set into piece 4 of that file's zero node.
;;
;;You may specify one or both of these files to be corrected.
;;
;;These files are corrected by a queued background job. When the job completes,
;;you will be notified by email message.
QUIT
;
EOR ; HLUOPT6 - Fix zero node of file 772 or 773 ;5/12/03 09:02
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUOPT6 4743 printed Nov 22, 2024@17:10:30 Page 2
HLUOPT6 ;CIOFO-O/LJA - Fix zero node of file 772 or 773 ;02/04/2004 09:02
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
+3 QUIT
+4 ;
+5 ; This utility queues a background job to recalculate and reset
+6 ; pieces 3 (last IEN) and 4 (# entries) in the zero nodes for
+7 ; the HL Message Text file (#772) and the HL Message Administration
+8 ; file (#773).
+9 ;
FIXZERO ; Reset piece 3 & 4 of zero node of file 772 &/or 773...
+1 NEW FILE,GBL,IOINHI,IOINORM,LIST,X,Y
+2 DO HD
+3 DO EX
+4 SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
+5 WRITE !!,?3,IOINHI,"Note:",IOINORM," ",IOINHI
+6 WRITE "This utility should be run when no purge processes are running.",IOINORM
+7 ;
+8 FOR
if ($Y+4)>IOSL
QUIT
WRITE !
+9 ;->
if '$$BTE("Press RETURN to continue, or '^' to exit... ")
QUIT
+10 ;
+11 DO HD
+12 ;
+13 ;->
DO FILE(.LIST)
if '$DATA(LIST)
QUIT
+14 WRITE !!,"The process which fixes the zero node will now be queued to a background job."
+15 WRITE !,"When complete, a verification Mailman message will be sent to you on this"
+16 WRITE !,"system."
+17 ;->
SET X=$$BTE("Press RETURN to queue job, or '^' to exit... ",1)
IF 'X
Begin DoDot:1
+18 WRITE " exiting... "
End DoDot:1
QUIT
+19 DO ZTSK
+20 SET X=$$BTE("Press RETURN to exit... ",1)
+21 QUIT
+22 ;
ZTSK ;
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+2 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="HL7 Zero Node Correction"
+3 SET ZTRTN="QUEUE^HLUOPT6"
+4 SET ZTSAVE("LIST(")=""
+5 DO ^%ZTLOAD
+6 WRITE !!,"Queued to task# ",ZTSK,"..."
+7 QUIT
+8 ;
QUEUE ;
+1 NEW FILE,ZERO
+2 SET FILE=0
+3 FOR
SET FILE=$ORDER(LIST(FILE))
if FILE'>0
QUIT
Begin DoDot:1
+4 DO CORR(+FILE,.ZERO)
End DoDot:1
+5 DO MAIL
+6 QUIT
+7 ;
CORR(FILE,ZERO) ; Correct zero node for file...
+1 ; NOTE: No purging actions should be occurring now...
+2 NEW CT,GBL,GBL0,IEN,LAST,NEW0
+3 ;
+4 SET GBL=$SELECT(FILE=772:"^HL(772)",1:"^HLMA")
+5 SET GBL0=$SELECT(FILE=772:"^HL(772,0)",1:"^HLMA(0)")
+6 SET ZERO(1,FILE)=@GBL0
+7 ;
+8 SET CT=0
SET IEN=0
SET LAST=""
+9 FOR
SET IEN=$ORDER(@GBL@(IEN))
if 'IEN
QUIT
Begin DoDot:1
+10 ;->
if $PIECE($GET(@GBL@(+IEN,0)),U)']""
QUIT
+11 SET CT=CT+1
SET LAST=IEN
End DoDot:1
+12 ;
+13 SET (NEW0,ZERO(2,FILE))=$PIECE(ZERO(1,FILE),U,1,2)_U_LAST_U_CT
+14 ;
+15 IF FILE=772
Begin DoDot:1
+16 ; Reset zero node even if fail...
LOCK +^HL(772,0):30
+17 SET ^HL(772,0)=NEW0
+18 LOCK -^HL(772,0)
End DoDot:1
+19 ;
+20 IF FILE=773
Begin DoDot:1
+21 LOCK +^HLMA(0):30
+22 SET ^HLMA(0)=NEW0
+23 LOCK -^HLMA(0)
End DoDot:1
+24 ;
+25 QUIT
+26 ;
MAIL ; Send Mailman message.
+1 NEW NO,TEXT,XMDUZ,XMSUB,XMTEXT,XMZ
+2 SET XMDUZ=.5
SET XMSUB="HL7 Zero Node Correction"
+3 SET XMTEXT="^TMP("_$JOB_",""HLMAILMSG"","
+4 KILL ^TMP($JOB,"HLMAILMSG")
+5 SET NO=0
+6 DO MSGBODY
+7 SET XMY(DUZ)=""
+8 DO ^XMD
+9 KILL ^TMP($JOB,"HLMAILMSG")
+10 QUIT
+11 ;
MSGBODY ; Add message bode...
+1 ; LIST,ZERO -- req
+2 NEW CT,FILE
+3 SET CT=-1
SET FILE=0
FOR
SET FILE=$ORDER(LIST(FILE))
if 'FILE
QUIT
SET CT=CT+1
+4 DO MAILADD("The zero node for file"_$SELECT(CT:"s 772 & 773 have",1:" "_$ORDER(LIST(0))_" has")_" now been reset.")
+5 SET FILE=0
+6 FOR
SET FILE=$ORDER(LIST(FILE))
if 'FILE
QUIT
Begin DoDot:1
+7 DO MAILADD("")
+8 DO MAILADD("File "_FILE_" zero node reset from... "_$GET(ZERO(1,FILE)))
+9 DO MAILADD(" to... "_$GET(ZERO(2,FILE)))
End DoDot:1
+10 QUIT
+11 ;
MAILADD(T) SET NO=$GET(NO)+1
SET ^TMP($JOB,"HLMAILMSG",NO)=T
+1 QUIT
+2 ;
BTE(PMT,FF) ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 FOR X=1:1:$GET(FF)
WRITE !
+3 SET DIR(0)="EA"
SET DIR("A")=$GET(PMT)
+4 DO ^DIR
+5 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT ""
+6 QUIT $SELECT(+Y=1:1,1:"")
+7 ;
FILE(LIST) ; Ask which files to correct..
+1 ; IOINHI,IOINORM -- req
+2 NEW DIR,DIRUT,DTOUT,DUOUT,TXT,X,Y
+3 KILL LIST
+4 WRITE !!,"Select the file(s) now whose zero nodes should be corrected."
+5 WRITE !!,?10,$$CJ^XLFSTR("Zero Node Current Value",60)
+6 WRITE !,?10,$$REPEAT^XLFSTR("-",60)
+7 WRITE !,?13,"^HL(772,0) = "
+8 DO SH0($GET(^HL(772,0)))
+9 WRITE !,?13,"^HLMA(0) = "
+10 DO SH0($GET(^HLMA(0)))
+11 WRITE !
+12 SET DIR(0)="S^1:Correct file 772;2:Correct file 773;3:Correct both file 772 & 773"
+13 SET DIR("A")="Select file(s) to correct"
+14 DO ^DIR
+15 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))!(+Y'>0)
QUIT
+16 if +Y=1
SET LIST(772)=""
+17 if +Y=2
SET LIST(773)=""
+18 IF +Y=3
SET LIST(772)=""
SET LIST(773)=""
+19 QUIT
+20 ;
SH0(TXT) ; Highlight 3rd and 4th pieces...
+1 ; IOINHI,IOINORM -- req
+2 NEW PCE,VAL
+3 WRITE $PIECE(TXT,U,1,2),U,IOINHI,$PIECE(TXT,U,3),IOINORM,U,IOINHI,$PIECE(TXT,U,4),IOINORM
+4 QUIT
+5 ;
HD WRITE @IOF,$$CJ^XLFSTR("File 772/773 Header Correction",IOM)
+1 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+2 QUIT
+3 ;
EX NEW I,T
FOR I=1:1
SET T=$TEXT(EX+I)
if T'[";;"
QUIT
WRITE !,$PIECE(T,";;",2,99)
+1 ;;This utility corrects the zero node of the HL Message Text file (#772) and the
+2 ;;HL Message Administration file (#773.) The following corrections will be made:
+3 ;;
+4 ;; - The last internal entry number will be found and set into piece 3 of the
+5 ;; file's zero node.
+6 ;;
+7 ;; - The number of entries in the file being corrected will be recalculated and
+8 ;; set into piece 4 of that file's zero node.
+9 ;;
+10 ;;You may specify one or both of these files to be corrected.
+11 ;;
+12 ;;These files are corrected by a queued background job. When the job completes,
+13 ;;you will be notified by email message.
+14 QUIT
+15 ;
EOR ; HLUOPT6 - Fix zero node of file 772 or 773 ;5/12/03 09:02
