Routine: HLEVX002

HLEVX002 ;O-OIFO/LJA - HL7 Xref Check ;02/04/2004 15:25

 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995

 ; Event Types... AC-HUNG, AC-PROC'D, AC-NO 773, AC-NO 870

CHECKAC ; Check file 773 AC xref...

 N ABRT,CTERR,CTXREF,ERRNO,GBL,IEN773,IEN870,NOW,XTMP,WAY,X

 D DEBUG^HLEVAPI2("CHECKAC")

 D START^HLEVAPI("CTERR^CTXREF")

 KILL ^TMP($J,"HLEV REP"),^TMP($J,"HLEVREP"),^TMP($J,"HLMAIL773")

 ; Current XMTP

 S NOW=$$NOW^XLFDT

 S XTMP="HLEV CHK773AC "_NOW

 S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,3)_U_NOW_U_"VistA HL7 773 AC Xref Check"_U_"Task# "_$G(ZTSK)

 ; Previous XTMP...

 S X=$O(^XTMP(XTMP),-1),XTMP(1)=$S(X["HLEV CHK773AC":X,1:"")

 S GBL="^HLMA(""AC"")"

 ; Check Xref...

 S WAY="",(ABRT,CTERR,ERRNO)=0

 F  S WAY=$O(@GBL@(WAY)) Q:WAY']""!(ABRT)  D

 .  S IEN870=0

 .  F  S IEN870=$O(@GBL@(WAY,IEN870)) Q:'IEN870!(ABRT)  D

 .  .  S IEN773=0,CTXREF=0

 .  .  F  S IEN773=$O(@GBL@(WAY,IEN870,IEN773)) Q:'IEN773!(ABRT)  D

 .  .  .  S CTXREF=CTXREF+1

 .  .  .  I '(CTXREF#1000) D  I $$S^%ZTLOAD S ABRT=1 QUIT  ;->

 .  .  .  .  D CHECKIN^HLEVAPI

 .  .  .  .  S $P(^XTMP(XTMP,0),U,5)=$$NOW^XLFDT

 .  .  .  S ^XTMP(XTMP,"CURR",WAY,IEN870,IEN773)=NOW ; Next run record

 .  .  .  D CHKAC(WAY,IEN870,IEN773)

 D CHECKOUT^HLEVAPI

 S X("HLEV REP")=$NA(^TMP($J,"HLEV REP")) D DEBUG^HLEVAPI2("CHECKAC-3",.X)

 ; Create report global, and move into ^TMP($J,"HLEVREP")...

 D GENREP^HLEVUTI0($NA(^TMP($J,"HLEV REP")),$NA(^TMP($J,"HLEVREP")),4,1)

 D MAIL773

 D MSGTEXT^HLEVAPI1($NA(^TMP($J,"HLEVREP")))

 ; Send email if errors exist...

 I ERRNO>0 D

 .  S HLEVTXT(1)="MESSAGETEXT"

 .  D MAILIT^HLEVAPI

 S X("HLEV REP")=$NA(^TMP($J,"HLEV REP")) D DEBUG^HLEVAPI2("CHECKAC-3",.X)

 KILL ^TMP($J,"HLEV REP"),^TMP($J,"HLEVREP"),^TMP($J,"HLMAIL773")

CHKAC(WAY,IEN870,IEN773) ; Check AC xref...

 ; Record in ^XTMP... (Next run compared to this for "hangarounds")

 S ^XTMP(XTMP,"CURR",WAY,IEN870,IEN773)=NOW

 S WAY(1)=$S(WAY="I":"IN",1:"OUT")

 ; Does link exist?

 I $G(^HLCS(870,+IEN870,0))']"" D  QUIT  ;->

 .  D ERR(WAY(1),IEN870,IEN773,"No 870","AC-NO 870")

 ; Make sure zero node exists...

 I $G(^HLMA(+IEN773,0))']"" D  QUIT  ;->

 .  D ERR(WAY(1),IEN870,IEN773,"No 773","AC-NO 773")

 ; Make sure AC xref should exist...

 I $G(^HLMA(+IEN773,"P"))?7N1"."1.N D  QUIT  ;->

 .  D ERR(WAY(1),IEN870,IEN773,"Proc'd","AC-PROC'D")

 ; Check only for first entry...

 QUIT:CTXREF>1  ;->

 ; Check for "hang around" AC xrefs...

 I $G(XTMP(1))]"" D

 .  ; Quit if didn't exist last run...

 .  QUIT:'$D(^XTMP(XTMP(1),"CURR",WAY,IEN870,IEN773))  ;->

 .  QUIT:$P($$UP^XLFSTR($G(^HLCS(870,+IEN870,0))),U,5)["SHUTDOWN"  ;->

 .  D ERR($S(WAY=1:"IN",1:"OUT"),IEN870,IEN773,"Hung#","AC-HUNG")

ERR(WAY,IEN870,IEN773,REA,ETYPE) ;

 ; ERRNO -- req

 ; Has this problem already been logged?

 QUIT:'$$LOG^HLEVAPI2($G(ETYPE),"WAY^IEN870^IEN773")  ;->

 ; $$LOG creates (where AC-HUNG = ETYPE)...

 ; ^HLEV(776.4,"AH","AC-HUNG","IN",25,15333) = 100

 ; ^HLEV(776.4,"AH","AC-HUNG","X776",1183,100) = 100

 ; ^HLEV(776.4,"AH","AC-HUNG","X7764",100,1183) = 100

 ; 1183 = 776 ien    100 = 776.4 ien

 S ERRNO=$G(ERRNO)+1

 D RECORD^HLEVX000("773 AC-"_REA,WAY,IEN870,IEN773)

 S ^TMP($J,"HLMAIL773",IEN870,WAY,+IEN773)=$$NEXTACS(WAY,IEN870,IEN773)

NEXTACS(WAY,IEN870,I773) ; Store the next two entries...

 N CT,NEXTIENS

 S WAY=$E(WAY),NEXTIENS="",CT=0

 F  S I773=$O(^HLMA("AC",WAY,IEN870,I773)) Q:'I773!(CT=2)  D

 .  S CT=CT+1

 .  S NEXTIENS=NEXTIENS_$S(NEXTIENS]"":U,1:"")_I773

 Q NEXTIENS

MAIL773 ; Add collected 773 entry data to email message...

 N CT,I773,IEN773,IEN870,LINKNM,NEXTACS,WAY

 D ADD("")

 S IEN870=0

 F  S IEN870=$O(^TMP($J,"HLMAIL773",IEN870)) Q:IEN870'>0  D

 .  S DATA=$G(^HLCS(870,+IEN870,0))

 .  S LINKNM=$P(DATA,U)_" [#"_IEN870_"] "

 .  D ADD("")

 .  D ADD($$CJ^XLFSTR(LINKNM_" ",74,"="))

 .  F NODE=0,100,200,300,400 D ADDNODE(NODE,NODE,IEN870)

 .  S WAY=""

 .  F  S WAY=$O(^TMP($J,"HLMAIL773",IEN870,WAY)) Q:WAY']""  D

 .  .  S IEN773=0,CT=0

 .  .  F  S IEN773=$O(^TMP($J,"HLMAIL773",IEN870,WAY,IEN773)) Q:IEN773'>0  D

 .  .  .  S CT=CT+1

 .  .  .  I CT=1 D ADD($$CJ^XLFSTR(" "_$S($E(WAY)="I":"INCOMING",1:"OUTGOING")_" ",74,"="))

 .  .  .  D DATA773(+IEN773," Problem AC Entry ") ; Problem entry...

 .  .  .  ; Add next two 773s...

 .  .  .  S NEXTACS=$G(^TMP($J,"HLMAIL773",IEN870,WAY,IEN773)) QUIT:NEXTACS']""  ;->

 .  .  .  F PCE=1:1:$L(NEXTACS,U) D

 .  .  .  .  S I773=+$P(NEXTACS,U,PCE) QUIT:I773'>0  ;->

 .  .  .  .  D DATA773(I773," Entry After AC Problem ")

ADDNODE(NODE,NAME,IEN870) ; Add node data prefixed by node name...

 N DATA,PFX

 S PFX=$S(NODE=+NODE:"",1:"""")

 S DATA="^HLCS(870,"_IEN870_","_PFX_NAME_PFX_")="_$G(^HLCS(870,+IEN870,NODE))

 D ADD(DATA)

DATA773(IEN773,PROBL) ; Add critical data to Email message...

 N DATA773,NO

 D ADD($$CJ^XLFSTR($G(PROBL),74,"="))

 KILL ^TMP($J,"HLDATA773")

 ; Collect 773 informaiton...

 D ENDIQ1^HLEVUTIL(773,+IEN773,"HLDATA773")

 S ^TMP($J,"HLDATA773",1)="       "_$$CJ^XLFSTR(" 773# "_IEN773_" ",60,"-")_"       "

 S NO=0

 F  S NO=$O(^TMP($J,"HLDATA773",NO)) Q:NO'>0  D

 .  D ADD(^TMP($J,"HLDATA773",+NO))

 KILL ^TMP($J,"HLDATA773")

ADD(TXT,TRAIL) ; Add TXT to ^TMP($J,"HLEVREP",#)...

 N COL,LEN,NO,TXTOLD

 S LEN=$L($P(TXT,"=")),LEN=$S('LEN:3,LEN<55:LEN+1,1:3)

 F  D  QUIT:TXT']""

 .  S NO=$O(^TMP($J,"HLEVREP",":"),-1)+1

 .  S ^TMP($J,"HLEVREP",+NO)=$E(TXT,1,74)

 .  S TXT=$E(TXT,75,999) QUIT:TXT']""  ;->

 .  S TXT=$$REPEAT^XLFSTR(" ",LEN)_TXT

EOR ;HLEVX002 - VistA HL7 Event Monitor Code ;5/30/03 15:25

HLEVX002.m