| 1 | HLEVX002 ;O-OIFO/LJA - HL7 Xref Check ;02/04/2004 15:25
|
---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
---|
| 3 | ;
|
---|
| 4 | ; Event Types... AC-HUNG, AC-PROC'D, AC-NO 773, AC-NO 870
|
---|
| 5 | ;
|
---|
| 6 | CHECKAC ; Check file 773 AC xref...
|
---|
| 7 | N ABRT,CTERR,CTXREF,ERRNO,GBL,IEN773,IEN870,NOW,XTMP,WAY,X
|
---|
| 8 | ;
|
---|
| 9 | D DEBUG^HLEVAPI2("CHECKAC")
|
---|
| 10 | D START^HLEVAPI("CTERR^CTXREF")
|
---|
| 11 | ;
|
---|
| 12 | KILL ^TMP($J,"HLEV REP"),^TMP($J,"HLEVREP"),^TMP($J,"HLMAIL773")
|
---|
| 13 | ;
|
---|
| 14 | ; Current XMTP
|
---|
| 15 | S NOW=$$NOW^XLFDT
|
---|
| 16 | S XTMP="HLEV CHK773AC "_NOW
|
---|
| 17 | S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,3)_U_NOW_U_"VistA HL7 773 AC Xref Check"_U_"Task# "_$G(ZTSK)
|
---|
| 18 | ;
|
---|
| 19 | ; Previous XTMP...
|
---|
| 20 | S X=$O(^XTMP(XTMP),-1),XTMP(1)=$S(X["HLEV CHK773AC":X,1:"")
|
---|
| 21 | ;
|
---|
| 22 | S GBL="^HLMA(""AC"")"
|
---|
| 23 | ; Check Xref...
|
---|
| 24 | S WAY="",(ABRT,CTERR,ERRNO)=0
|
---|
| 25 | F S WAY=$O(@GBL@(WAY)) Q:WAY']""!(ABRT) D
|
---|
| 26 | . S IEN870=0
|
---|
| 27 | . F S IEN870=$O(@GBL@(WAY,IEN870)) Q:'IEN870!(ABRT) D
|
---|
| 28 | . . S IEN773=0,CTXREF=0
|
---|
| 29 | . . F S IEN773=$O(@GBL@(WAY,IEN870,IEN773)) Q:'IEN773!(ABRT) D
|
---|
| 30 | . . . S CTXREF=CTXREF+1
|
---|
| 31 | . . . I '(CTXREF#1000) D I $$S^%ZTLOAD S ABRT=1 QUIT ;->
|
---|
| 32 | . . . . D CHECKIN^HLEVAPI
|
---|
| 33 | . . . . S $P(^XTMP(XTMP,0),U,5)=$$NOW^XLFDT
|
---|
| 34 | . . . S ^XTMP(XTMP,"CURR",WAY,IEN870,IEN773)=NOW ; Next run record
|
---|
| 35 | . . . D CHKAC(WAY,IEN870,IEN773)
|
---|
| 36 | ;
|
---|
| 37 | D CHECKOUT^HLEVAPI
|
---|
| 38 | ;
|
---|
| 39 | S X("HLEV REP")=$NA(^TMP($J,"HLEV REP")) D DEBUG^HLEVAPI2("CHECKAC-3",.X)
|
---|
| 40 | ;
|
---|
| 41 | ; Create report global, and move into ^TMP($J,"HLEVREP")...
|
---|
| 42 | D GENREP^HLEVUTI0($NA(^TMP($J,"HLEV REP")),$NA(^TMP($J,"HLEVREP")),4,1)
|
---|
| 43 | D MAIL773
|
---|
| 44 | D MSGTEXT^HLEVAPI1($NA(^TMP($J,"HLEVREP")))
|
---|
| 45 | ;
|
---|
| 46 | ; Send email if errors exist...
|
---|
| 47 | I ERRNO>0 D
|
---|
| 48 | . S HLEVTXT(1)="MESSAGETEXT"
|
---|
| 49 | . D MAILIT^HLEVAPI
|
---|
| 50 | ;
|
---|
| 51 | S X("HLEV REP")=$NA(^TMP($J,"HLEV REP")) D DEBUG^HLEVAPI2("CHECKAC-3",.X)
|
---|
| 52 | ;
|
---|
| 53 | KILL ^TMP($J,"HLEV REP"),^TMP($J,"HLEVREP"),^TMP($J,"HLMAIL773")
|
---|
| 54 | ;
|
---|
| 55 | Q
|
---|
| 56 | ;
|
---|
| 57 | CHKAC(WAY,IEN870,IEN773) ; Check AC xref...
|
---|
| 58 | ;
|
---|
| 59 | ; Record in ^XTMP... (Next run compared to this for "hangarounds")
|
---|
| 60 | S ^XTMP(XTMP,"CURR",WAY,IEN870,IEN773)=NOW
|
---|
| 61 | ;
|
---|
| 62 | S WAY(1)=$S(WAY="I":"IN",1:"OUT")
|
---|
| 63 | ;
|
---|
| 64 | ; Does link exist?
|
---|
| 65 | I $G(^HLCS(870,+IEN870,0))']"" D QUIT ;->
|
---|
| 66 | . D ERR(WAY(1),IEN870,IEN773,"No 870","AC-NO 870")
|
---|
| 67 | ;
|
---|
| 68 | ; Make sure zero node exists...
|
---|
| 69 | I $G(^HLMA(+IEN773,0))']"" D QUIT ;->
|
---|
| 70 | . D ERR(WAY(1),IEN870,IEN773,"No 773","AC-NO 773")
|
---|
| 71 | ;
|
---|
| 72 | ; Make sure AC xref should exist...
|
---|
| 73 | I $G(^HLMA(+IEN773,"P"))?7N1"."1.N D QUIT ;->
|
---|
| 74 | . D ERR(WAY(1),IEN870,IEN773,"Proc'd","AC-PROC'D")
|
---|
| 75 | ;
|
---|
| 76 | ; Check only for first entry...
|
---|
| 77 | QUIT:CTXREF>1 ;->
|
---|
| 78 | ;
|
---|
| 79 | ; Check for "hang around" AC xrefs...
|
---|
| 80 | I $G(XTMP(1))]"" D
|
---|
| 81 | . ; Quit if didn't exist last run...
|
---|
| 82 | . QUIT:'$D(^XTMP(XTMP(1),"CURR",WAY,IEN870,IEN773)) ;->
|
---|
| 83 | . QUIT:$P($$UP^XLFSTR($G(^HLCS(870,+IEN870,0))),U,5)["SHUTDOWN" ;->
|
---|
| 84 | . D ERR($S(WAY=1:"IN",1:"OUT"),IEN870,IEN773,"Hung#","AC-HUNG")
|
---|
| 85 | ;
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | ERR(WAY,IEN870,IEN773,REA,ETYPE) ;
|
---|
| 89 | ; ERRNO -- req
|
---|
| 90 | ;
|
---|
| 91 | ; Has this problem already been logged?
|
---|
| 92 | QUIT:'$$LOG^HLEVAPI2($G(ETYPE),"WAY^IEN870^IEN773") ;->
|
---|
| 93 | ;
|
---|
| 94 | ; $$LOG creates (where AC-HUNG = ETYPE)...
|
---|
| 95 | ; ^HLEV(776.4,"AH","AC-HUNG","IN",25,15333) = 100
|
---|
| 96 | ; ^HLEV(776.4,"AH","AC-HUNG","X776",1183,100) = 100
|
---|
| 97 | ; ^HLEV(776.4,"AH","AC-HUNG","X7764",100,1183) = 100
|
---|
| 98 | ; 1183 = 776 ien 100 = 776.4 ien
|
---|
| 99 | ;
|
---|
| 100 | S ERRNO=$G(ERRNO)+1
|
---|
| 101 | D RECORD^HLEVX000("773 AC-"_REA,WAY,IEN870,IEN773)
|
---|
| 102 | S ^TMP($J,"HLMAIL773",IEN870,WAY,+IEN773)=$$NEXTACS(WAY,IEN870,IEN773)
|
---|
| 103 | ;
|
---|
| 104 | Q
|
---|
| 105 | ;
|
---|
| 106 | NEXTACS(WAY,IEN870,I773) ; Store the next two entries...
|
---|
| 107 | N CT,NEXTIENS
|
---|
| 108 | S WAY=$E(WAY),NEXTIENS="",CT=0
|
---|
| 109 | F S I773=$O(^HLMA("AC",WAY,IEN870,I773)) Q:'I773!(CT=2) D
|
---|
| 110 | . S CT=CT+1
|
---|
| 111 | . S NEXTIENS=NEXTIENS_$S(NEXTIENS]"":U,1:"")_I773
|
---|
| 112 | Q NEXTIENS
|
---|
| 113 | ;
|
---|
| 114 | MAIL773 ; Add collected 773 entry data to email message...
|
---|
| 115 | N CT,I773,IEN773,IEN870,LINKNM,NEXTACS,WAY
|
---|
| 116 | ;
|
---|
| 117 | D ADD("")
|
---|
| 118 | ;
|
---|
| 119 | S IEN870=0
|
---|
| 120 | F S IEN870=$O(^TMP($J,"HLMAIL773",IEN870)) Q:IEN870'>0 D
|
---|
| 121 | . S DATA=$G(^HLCS(870,+IEN870,0))
|
---|
| 122 | . S LINKNM=$P(DATA,U)_" [#"_IEN870_"] "
|
---|
| 123 | . D ADD("")
|
---|
| 124 | . D ADD($$CJ^XLFSTR(LINKNM_" ",74,"="))
|
---|
| 125 | . F NODE=0,100,200,300,400 D ADDNODE(NODE,NODE,IEN870)
|
---|
| 126 | . S WAY=""
|
---|
| 127 | . F S WAY=$O(^TMP($J,"HLMAIL773",IEN870,WAY)) Q:WAY']"" D
|
---|
| 128 | . . S IEN773=0,CT=0
|
---|
| 129 | . . F S IEN773=$O(^TMP($J,"HLMAIL773",IEN870,WAY,IEN773)) Q:IEN773'>0 D
|
---|
| 130 | . . . S CT=CT+1
|
---|
| 131 | . . . I CT=1 D ADD($$CJ^XLFSTR(" "_$S($E(WAY)="I":"INCOMING",1:"OUTGOING")_" ",74,"="))
|
---|
| 132 | . . . D DATA773(+IEN773," Problem AC Entry ") ; Problem entry...
|
---|
| 133 | . . . ; Add next two 773s...
|
---|
| 134 | . . . S NEXTACS=$G(^TMP($J,"HLMAIL773",IEN870,WAY,IEN773)) QUIT:NEXTACS']"" ;->
|
---|
| 135 | . . . F PCE=1:1:$L(NEXTACS,U) D
|
---|
| 136 | . . . . S I773=+$P(NEXTACS,U,PCE) QUIT:I773'>0 ;->
|
---|
| 137 | . . . . D DATA773(I773," Entry After AC Problem ")
|
---|
| 138 | ;
|
---|
| 139 | Q
|
---|
| 140 | ;
|
---|
| 141 | ADDNODE(NODE,NAME,IEN870) ; Add node data prefixed by node name...
|
---|
| 142 | N DATA,PFX
|
---|
| 143 | S PFX=$S(NODE=+NODE:"",1:"""")
|
---|
| 144 | S DATA="^HLCS(870,"_IEN870_","_PFX_NAME_PFX_")="_$G(^HLCS(870,+IEN870,NODE))
|
---|
| 145 | D ADD(DATA)
|
---|
| 146 | Q
|
---|
| 147 | ;
|
---|
| 148 | DATA773(IEN773,PROBL) ; Add critical data to Email message...
|
---|
| 149 | N DATA773,NO
|
---|
| 150 | ;
|
---|
| 151 | D ADD($$CJ^XLFSTR($G(PROBL),74,"="))
|
---|
| 152 | ;
|
---|
| 153 | KILL ^TMP($J,"HLDATA773")
|
---|
| 154 | ;
|
---|
| 155 | ; Collect 773 informaiton...
|
---|
| 156 | D ENDIQ1^HLEVUTIL(773,+IEN773,"HLDATA773")
|
---|
| 157 | ;
|
---|
| 158 | S ^TMP($J,"HLDATA773",1)=" "_$$CJ^XLFSTR(" 773# "_IEN773_" ",60,"-")_" "
|
---|
| 159 | S NO=0
|
---|
| 160 | F S NO=$O(^TMP($J,"HLDATA773",NO)) Q:NO'>0 D
|
---|
| 161 | . D ADD(^TMP($J,"HLDATA773",+NO))
|
---|
| 162 | ;
|
---|
| 163 | KILL ^TMP($J,"HLDATA773")
|
---|
| 164 | ;
|
---|
| 165 | Q
|
---|
| 166 | ;
|
---|
| 167 | ADD(TXT,TRAIL) ; Add TXT to ^TMP($J,"HLEVREP",#)...
|
---|
| 168 | N COL,LEN,NO,TXTOLD
|
---|
| 169 | ;
|
---|
| 170 | S LEN=$L($P(TXT,"=")),LEN=$S('LEN:3,LEN<55:LEN+1,1:3)
|
---|
| 171 | ;
|
---|
| 172 | F D QUIT:TXT']""
|
---|
| 173 | . S NO=$O(^TMP($J,"HLEVREP",":"),-1)+1
|
---|
| 174 | . S ^TMP($J,"HLEVREP",+NO)=$E(TXT,1,74)
|
---|
| 175 | . S TXT=$E(TXT,75,999) QUIT:TXT']"" ;->
|
---|
| 176 | . S TXT=$$REPEAT^XLFSTR(" ",LEN)_TXT
|
---|
| 177 | ;
|
---|
| 178 | Q
|
---|
| 179 | ;
|
---|
| 180 | EOR ;HLEVX002 - VistA HL7 Event Monitor Code ;5/30/03 15:25
|
---|