YTQEVNT ;SLC/KCM - MHA Protocol Events ; 1/25/2017
;;5.01;MENTAL HEALTH;**240**;Dec 30, 1994;Build 10
;
Q
; IEN is always the administration IEN in 601.84
; TRIGGER identifies where the event was invoked
; DFN & TEST identify the patient and instrument for removals
; (since the 601.84 record is no longer available)
;
; Properties --
; action: update or remove
; object: admin, answers, results, or assessment (for all 3)
; trigger: identifies caller
; ien: pointer to 601.84
; dfn: pointer to 2
; test: short name of instrument
;
UPADM(IEN,TRIGGER) ; fire event when administration is updated
D UPSEND(IEN,TRIGGER,"admin")
Q
UPANS(IEN,TRIGGER) ; fire event when answers to administration are updated
D UPSEND(IEN,TRIGGER,"answers")
Q
UPRSLT(IEN,TRIGGER) ; fire event when results for administration are updated
D UPSEND(IEN,TRIGGER,"results")
Q
UPSEND(IEN,TRIGGER,OBJECT) ; do the actual update
N YTQEVNT,YTQ101,YTQX,X
I '$G(IEN) QUIT
S YTQX=$G(^YTT(601.84,IEN,0)) Q:'$L(YTQX)
I $P(YTQX,U,9)'="Y" QUIT ; only include completed administrations
S YTQ101=$$FIND1^DIC(101,"","BX","YTQ EVENT") Q:'YTQ101
S YTQEVNT("action")="update"
S YTQEVNT("object")=OBJECT
S YTQEVNT("trigger")=TRIGGER
S YTQEVNT("ien")=IEN
S YTQEVNT("dfn")=$P(YTQX,U,2)
S YTQEVNT("test")=$P($G(^YTT(601.71,$P(YTQX,U,3),0)),U)
S X=YTQ101_";ORD(101,"
D EN^XQOR
Q
DELETE(IEN,DFN,TEST,TRIGGER) ; fire event when administration is deleted
I '$G(IEN) QUIT
I '$L(TEST) QUIT
N YTQEVNT,YTQ101,X
S YTQ101=$$FIND1^DIC(101,"","BX","YTQ EVENT") Q:'YTQ101
S YTQEVNT("action")="remove"
S YTQEVNT("object")="assessment"
S YTQEVNT("trigger")=TRIGGER
S YTQEVNT("ien")=$G(IEN)
S YTQEVNT("dfn")=$G(DFN)
S YTQEVNT("test")=$G(TEST)
S X=YTQ101_";ORD(101,"
D EN^XQOR
Q
;
; -- test receiver --
;
RECEIVE ; YTQ EVENT TEST RECEIVER (save event data in ^XTMP)
; store events in sequence by date, example:
; ^XTMP("YTQEVTST-3230919",n,property)=value
; ^XTMP("YTQEVTST-3230919","CNT")=n
Q:$D(YTQEVNT)<10
N NOW,TODAY,NODE,CNT
S NOW=$$NOW^XLFDT,TODAY=$P(NOW,"."),NODE="YTQEVTST-"_TODAY
I '$D(^XTMP(NODE,0)) S ^XTMP(NODE,0)=$$FMADD^XLFDT(TODAY,1)_U_TODAY_U_"MHA Event Tester"
S ^XTMP(NODE,"CNT")=$G(^XTMP(NODE,"CNT"))+1,CNT=^("CNT")
M ^XTMP(NODE,CNT)=YTQEVNT
S ^XTMP(NODE,CNT,"user")=DUZ
S ^XTMP(NODE,CNT,"ts")=NOW
Q
;
; -- test receiver interactive monitor --
;
MONITOR ; for testing events published by MHA
; this may be run from the command line to watch events as they are posted
; NOTE -- the monitor doesn't support crossing midnight if you are up late
N NOW,TODAY,NODE,LAST,OUT,CNT,BUF,LOOPS
W !,"MHA Event Test Monitor -- press Q or spacebar to exit",!
S NOW=$$NOW^XLFDT,TODAY=$P(NOW,"."),NODE="YTQEVTST-"_TODAY,LOOPS=0
S LAST=$G(^XTMP(NODE,"CNT"),0) ; start with most recent update
S OUT=0 F D Q:OUT
. S CNT=$O(^XTMP(NODE,LAST))
. I CNT D SHOWEV(NODE,CNT) S LAST=CNT QUIT
. R BUF:1 I $L(BUF),(" qQ^"[BUF) S OUT=1 QUIT
. S LOOPS=LOOPS+1 W:LOOPS#8=0 "."
Q
SHOWEV(NODE,CNT) ; show a single event entry
; write timestamp action object:ien
; testName for patientName
; userLastName,initial (invoked from trigger)
;09/18/23@18:02:01 remove assessment:2342343
; CSI PARTNER VERSION for WINCHESTER,CHARLES EMERSON
; by JONES,M (invoked from edad)
N X
M X=^XTMP(NODE,CNT)
Q:$D(X)<10
W !,$$FMTE^XLFDT($G(X("ts")),"2ZS")
W ?18,$G(X("action"))," ",$G(X("object")),":",$G(X("ien")),!
W ?18,$G(X("test"))," for ",$P($G(^DPT(+$G(X("dfn")),0)),U),!
W ?18,"by ",$P($G(^VA(200,+$G(X("user")),0)),U)
W " (invoked from ",$G(X("trigger")),")",!
Q
;
CLEARALL ; clears all test event nodes in ^XTMP
S NODE="YTQEVTST-" F S NODE=$O(^XTMP(NODE)) Q:($E(NODE,1,9)'="YTQEVTST-") D
. W !,NODE
. K ^XTMP(NODE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQEVNT 3953 printed Sep 23, 2025@19:54:32 Page 2
YTQEVNT ;SLC/KCM - MHA Protocol Events ; 1/25/2017
+1 ;;5.01;MENTAL HEALTH;**240**;Dec 30, 1994;Build 10
+2 ;
+3 QUIT
+4 ; IEN is always the administration IEN in 601.84
+5 ; TRIGGER identifies where the event was invoked
+6 ; DFN & TEST identify the patient and instrument for removals
+7 ; (since the 601.84 record is no longer available)
+8 ;
+9 ; Properties --
+10 ; action: update or remove
+11 ; object: admin, answers, results, or assessment (for all 3)
+12 ; trigger: identifies caller
+13 ; ien: pointer to 601.84
+14 ; dfn: pointer to 2
+15 ; test: short name of instrument
+16 ;
UPADM(IEN,TRIGGER) ; fire event when administration is updated
+1 DO UPSEND(IEN,TRIGGER,"admin")
+2 QUIT
UPANS(IEN,TRIGGER) ; fire event when answers to administration are updated
+1 DO UPSEND(IEN,TRIGGER,"answers")
+2 QUIT
UPRSLT(IEN,TRIGGER) ; fire event when results for administration are updated
+1 DO UPSEND(IEN,TRIGGER,"results")
+2 QUIT
UPSEND(IEN,TRIGGER,OBJECT) ; do the actual update
+1 NEW YTQEVNT,YTQ101,YTQX,X
+2 IF '$GET(IEN)
QUIT
+3 SET YTQX=$GET(^YTT(601.84,IEN,0))
if '$LENGTH(YTQX)
QUIT
+4 ; only include completed administrations
IF $PIECE(YTQX,U,9)'="Y"
QUIT
+5 SET YTQ101=$$FIND1^DIC(101,"","BX","YTQ EVENT")
if 'YTQ101
QUIT
+6 SET YTQEVNT("action")="update"
+7 SET YTQEVNT("object")=OBJECT
+8 SET YTQEVNT("trigger")=TRIGGER
+9 SET YTQEVNT("ien")=IEN
+10 SET YTQEVNT("dfn")=$PIECE(YTQX,U,2)
+11 SET YTQEVNT("test")=$PIECE($GET(^YTT(601.71,$PIECE(YTQX,U,3),0)),U)
+12 SET X=YTQ101_";ORD(101,"
+13 DO EN^XQOR
+14 QUIT
DELETE(IEN,DFN,TEST,TRIGGER) ; fire event when administration is deleted
+1 IF '$GET(IEN)
QUIT
+2 IF '$LENGTH(TEST)
QUIT
+3 NEW YTQEVNT,YTQ101,X
+4 SET YTQ101=$$FIND1^DIC(101,"","BX","YTQ EVENT")
if 'YTQ101
QUIT
+5 SET YTQEVNT("action")="remove"
+6 SET YTQEVNT("object")="assessment"
+7 SET YTQEVNT("trigger")=TRIGGER
+8 SET YTQEVNT("ien")=$GET(IEN)
+9 SET YTQEVNT("dfn")=$GET(DFN)
+10 SET YTQEVNT("test")=$GET(TEST)
+11 SET X=YTQ101_";ORD(101,"
+12 DO EN^XQOR
+13 QUIT
+14 ;
+15 ; -- test receiver --
+16 ;
RECEIVE ; YTQ EVENT TEST RECEIVER (save event data in ^XTMP)
+1 ; store events in sequence by date, example:
+2 ; ^XTMP("YTQEVTST-3230919",n,property)=value
+3 ; ^XTMP("YTQEVTST-3230919","CNT")=n
+4 if $DATA(YTQEVNT)<10
QUIT
+5 NEW NOW,TODAY,NODE,CNT
+6 SET NOW=$$NOW^XLFDT
SET TODAY=$PIECE(NOW,".")
SET NODE="YTQEVTST-"_TODAY
+7 IF '$DATA(^XTMP(NODE,0))
SET ^XTMP(NODE,0)=$$FMADD^XLFDT(TODAY,1)_U_TODAY_U_"MHA Event Tester"
+8 SET ^XTMP(NODE,"CNT")=$GET(^XTMP(NODE,"CNT"))+1
SET CNT=^("CNT")
+9 MERGE ^XTMP(NODE,CNT)=YTQEVNT
+10 SET ^XTMP(NODE,CNT,"user")=DUZ
+11 SET ^XTMP(NODE,CNT,"ts")=NOW
+12 QUIT
+13 ;
+14 ; -- test receiver interactive monitor --
+15 ;
MONITOR ; for testing events published by MHA
+1 ; this may be run from the command line to watch events as they are posted
+2 ; NOTE -- the monitor doesn't support crossing midnight if you are up late
+3 NEW NOW,TODAY,NODE,LAST,OUT,CNT,BUF,LOOPS
+4 WRITE !,"MHA Event Test Monitor -- press Q or spacebar to exit",!
+5 SET NOW=$$NOW^XLFDT
SET TODAY=$PIECE(NOW,".")
SET NODE="YTQEVTST-"_TODAY
SET LOOPS=0
+6 ; start with most recent update
SET LAST=$GET(^XTMP(NODE,"CNT"),0)
+7 SET OUT=0
FOR
Begin DoDot:1
+8 SET CNT=$ORDER(^XTMP(NODE,LAST))
+9 IF CNT
DO SHOWEV(NODE,CNT)
SET LAST=CNT
QUIT
+10 READ BUF:1
IF $LENGTH(BUF)
IF (" qQ^"[BUF)
SET OUT=1
QUIT
+11 SET LOOPS=LOOPS+1
if LOOPS#8=0
WRITE "."
End DoDot:1
if OUT
QUIT
+12 QUIT
SHOWEV(NODE,CNT) ; show a single event entry
+1 ; write timestamp action object:ien
+2 ; testName for patientName
+3 ; userLastName,initial (invoked from trigger)
+4 ;09/18/23@18:02:01 remove assessment:2342343
+5 ; CSI PARTNER VERSION for WINCHESTER,CHARLES EMERSON
+6 ; by JONES,M (invoked from edad)
+7 NEW X
+8 MERGE X=^XTMP(NODE,CNT)
+9 if $DATA(X)<10
QUIT
+10 WRITE !,$$FMTE^XLFDT($GET(X("ts")),"2ZS")
+11 WRITE ?18,$GET(X("action"))," ",$GET(X("object")),":",$GET(X("ien")),!
+12 WRITE ?18,$GET(X("test"))," for ",$PIECE($GET(^DPT(+$GET(X("dfn")),0)),U),!
+13 WRITE ?18,"by ",$PIECE($GET(^VA(200,+$GET(X("user")),0)),U)
+14 WRITE " (invoked from ",$GET(X("trigger")),")",!
+15 QUIT
+16 ;
CLEARALL ; clears all test event nodes in ^XTMP
+1 SET NODE="YTQEVTST-"
FOR
SET NODE=$ORDER(^XTMP(NODE))
if ($EXTRACT(NODE,1,9)'="YTQEVTST-")
QUIT
Begin DoDot:1
+2 WRITE !,NODE
+3 KILL ^XTMP(NODE)
End DoDot:1
+4 QUIT
