- 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 Feb 18, 2025@23:44:44 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