Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLUOPT6

HLUOPT6.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  QUIT
  1.  ;
  1.  ; This utility queues a background job to recalculate and reset 
  1.  ; pieces 3 (last IEN) and 4 (# entries) in the zero nodes for
  1.  ; the HL Message Text file (#772) and the HL Message Administration
  1.  ; file (#773).
  1.  ;
  1. FIXZERO ; Reset piece 3 & 4 of zero node of file 772 &/or 773...
  1.  N FILE,GBL,IOINHI,IOINORM,LIST,X,Y
  1.  D HD
  1.  D EX
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,?3,IOINHI,"Note:",IOINORM,"  ",IOINHI
  1.  W "This utility should be run when no purge processes are running.",IOINORM
  1.  ;
  1.  F  Q:($Y+4)>IOSL  W !
  1.  QUIT:'$$BTE("Press RETURN to continue, or '^' to exit... ")  ;->
  1.  ;
  1.  D HD
  1.  ;
  1.  D FILE(.LIST) QUIT:'$D(LIST)  ;->
  1.  W !!,"The process which fixes the zero node will now be queued to a background job."
  1.  W !,"When complete, a verification Mailman message will be sent to you on this"
  1.  W !,"system."
  1.  S X=$$BTE("Press RETURN to queue job, or '^' to exit... ",1) I 'X D  QUIT  ;->
  1.  .  W "   exiting... "
  1.  D ZTSK
  1.  S X=$$BTE("Press RETURN to exit... ",1)
  1.  Q
  1.  ;
  1. ZTSK ;
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
  1.  S ZTIO="",ZTDTH=$H,ZTDESC="HL7 Zero Node Correction"
  1.  S ZTRTN="QUEUE^HLUOPT6"
  1.  S ZTSAVE("LIST(")=""
  1.  D ^%ZTLOAD
  1.  W !!,"Queued to task# ",ZTSK,"..."
  1.  QUIT
  1.  ;
  1. QUEUE ;
  1.  N FILE,ZERO
  1.  S FILE=0
  1.  F  S FILE=$O(LIST(FILE)) Q:FILE'>0  D
  1.  .  D CORR(+FILE,.ZERO)
  1.  D MAIL
  1.  Q
  1.  ;
  1. CORR(FILE,ZERO) ; Correct zero node for file...
  1.  ; NOTE: No purging actions should be occurring now...
  1.  N CT,GBL,GBL0,IEN,LAST,NEW0
  1.  ;
  1.  S GBL=$S(FILE=772:"^HL(772)",1:"^HLMA")
  1.  S GBL0=$S(FILE=772:"^HL(772,0)",1:"^HLMA(0)")
  1.  S ZERO(1,FILE)=@GBL0
  1.  ;
  1.  S CT=0,IEN=0,LAST=""
  1.  F  S IEN=$O(@GBL@(IEN)) Q:'IEN  D
  1.  .  QUIT:$P($G(@GBL@(+IEN,0)),U)']""  ;->
  1.  .  S CT=CT+1,LAST=IEN
  1.  ;
  1.  S (NEW0,ZERO(2,FILE))=$P(ZERO(1,FILE),U,1,2)_U_LAST_U_CT
  1.  ;
  1.  I FILE=772 D
  1.  .  L +^HL(772,0):30  ; Reset zero node even if fail...
  1.  .  S ^HL(772,0)=NEW0
  1.  .  L -^HL(772,0)
  1.  ;
  1.  I FILE=773 D
  1.  .  L +^HLMA(0):30
  1.  .  S ^HLMA(0)=NEW0
  1.  .  L -^HLMA(0)
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ; Send Mailman message.
  1.  N NO,TEXT,XMDUZ,XMSUB,XMTEXT,XMZ
  1.  S XMDUZ=.5,XMSUB="HL7 Zero Node Correction"
  1.  S XMTEXT="^TMP("_$J_",""HLMAILMSG"","
  1.  KILL ^TMP($J,"HLMAILMSG")
  1.  S NO=0
  1.  D MSGBODY
  1.  S XMY(DUZ)=""
  1.  D ^XMD
  1.  KILL ^TMP($J,"HLMAILMSG")
  1.  QUIT
  1.  ;
  1. MSGBODY ; Add message bode...
  1.  ; LIST,ZERO -- req
  1.  N CT,FILE
  1.  S CT=-1,FILE=0 F  S FILE=$O(LIST(FILE)) Q:'FILE  S CT=CT+1
  1.  D MAILADD("The zero node for file"_$S(CT:"s 772 & 773 have",1:" "_$O(LIST(0))_" has")_" now been reset.")
  1.  S FILE=0
  1.  F  S FILE=$O(LIST(FILE)) Q:'FILE  D
  1.  .  D MAILADD("")
  1.  .  D MAILADD("File "_FILE_" zero node reset from... "_$G(ZERO(1,FILE)))
  1.  .  D MAILADD("                           to... "_$G(ZERO(2,FILE)))
  1.  Q
  1.  ;
  1. MAILADD(T) S NO=$G(NO)+1,^TMP($J,"HLMAILMSG",NO)=T
  1.  QUIT
  1.  ;
  1. BTE(PMT,FF) ; 
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  F X=1:1:$G(FF) W !
  1.  S DIR(0)="EA",DIR("A")=$G(PMT)
  1.  D ^DIR
  1.  QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
  1.  Q $S(+Y=1:1,1:"")
  1.  ;
  1. FILE(LIST) ; Ask which files to correct..
  1.  ; IOINHI,IOINORM -- req
  1.  N DIR,DIRUT,DTOUT,DUOUT,TXT,X,Y
  1.  KILL LIST
  1.  W !!,"Select the file(s) now whose zero nodes should be corrected."
  1.  W !!,?10,$$CJ^XLFSTR("Zero Node Current Value",60)
  1.  W !,?10,$$REPEAT^XLFSTR("-",60)
  1.  W !,?13,"^HL(772,0) = "
  1.  D SH0($G(^HL(772,0)))
  1.  W !,?13,"^HLMA(0) = "
  1.  D SH0($G(^HLMA(0)))
  1.  W !
  1.  S DIR(0)="S^1:Correct file 772;2:Correct file 773;3:Correct both file 772 & 773"
  1.  S DIR("A")="Select file(s) to correct"
  1.  D ^DIR
  1.  QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(+Y'>0)  ;->
  1.  S:+Y=1 LIST(772)=""
  1.  S:+Y=2 LIST(773)=""
  1.  I +Y=3 S LIST(772)="",LIST(773)=""
  1.  Q
  1.  ;
  1. SH0(TXT) ; Highlight 3rd and 4th pieces...
  1.  ; IOINHI,IOINORM -- req
  1.  N PCE,VAL
  1.  W $P(TXT,U,1,2),U,IOINHI,$P(TXT,U,3),IOINORM,U,IOINHI,$P(TXT,U,4),IOINORM
  1.  Q
  1.  ;
  1. HD W @IOF,$$CJ^XLFSTR("File 772/773 Header Correction",IOM)
  1.  W !,$$REPEAT^XLFSTR("=",IOM)
  1.  QUIT
  1.  ;
  1. EX N I,T F I=1:1 S T=$T(EX+I) QUIT:T'[";;"  W !,$P(T,";;",2,99)
  1.  ;;This utility corrects the zero node of the HL Message Text file (#772) and the
  1.  ;;HL Message Administration file (#773.)  The following corrections will be made:
  1.  ;;
  1.  ;; - The last internal entry number will be found and set into piece 3 of the 
  1.  ;;   file's zero node.  
  1.  ;;
  1.  ;; - The number of entries in the file being corrected will be recalculated and
  1.  ;;   set into piece 4 of that file's zero node. 
  1.  ;;
  1.  ;;You may specify one or both of these files to be corrected.
  1.  ;;
  1.  ;;These files are corrected by a queued background job.  When the job completes,
  1.  ;;you will be notified by email message.
  1.  QUIT
  1.  ;
  1. EOR ; HLUOPT6 - Fix zero node of file 772 or 773 ;5/12/03 09:02