GMRAVPR ;ISP/RFR - VPR CALLS FOR ART ;Nov 06, 2020@15:40
;;4.0;Adverse Reaction Tracking;**53,64**;Mar 29, 1996;Build 2
Q
ASSESS(OLDVAL,NEWVAL,DA,TYPE) ;NOTIFY SUBSCRIBERS OF ASSESSMENT CHANGES
;ALLOW THE SET CALL TO STORE THE DATA WHEN EDITING AN ENTRY
;DO NOT EXECUTE DURING A PRE-/POST-INSTALL OF THE RELATED INDEX
I (($G(TYPE)="KILL")&($G(NEWVAL(1))'=""))!($G(XPDNM)'="") Q
N OUTNODE,ACTION,REFS,SUBS,REF,SUB,PIECE,ORDER,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
S OUTNODE=$J_";"_DA
I $G(TYPE)="SET" S ACTION=$S($G(OLDVAL(1))="":"CREATED",1:"MODIFIED")
I $G(TYPE)="KILL" S ACTION="DELETED"
I ACTION="CREATED" S ^XTMP("GMRAVPR",OUTNODE,"BEFORE",0)="",REFS="NEWVAL",SUBS="AFTER"
I ACTION="MODIFIED" S REFS="OLDVAL"_U_"NEWVAL",SUBS="BEFORE"_U_"AFTER"
I ACTION="DELETED" S ^XTMP("GMRAVPR",OUTNODE,"AFTER",0)="",REFS="OLDVAL",SUBS="BEFORE"
S ^XTMP("GMRAVPR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT_U_"Notify Subscribers of ART Assessment Change"
S ^XTMP("GMRAVPR",OUTNODE)=DA
F PIECE=1:1 S REF=$P(REFS,U,PIECE) Q:REF="" D
.S SUB=$P(SUBS,U,PIECE)
.S ORDER=0 F S ORDER=$O(@REF@(ORDER)) Q:'+ORDER D
..I $G(@REF@(ORDER))'="" S $P(^XTMP("GMRAVPR",OUTNODE,SUB,0),U,ORDER)=$G(@REF@(ORDER))
S ZTRTN="ASSESSDQ^GMRAVPR"
S ZTDESC="GMRA ADVERSE REACTION ASSESSMENT CHANGE NOTIFIER"
S ZTDTH=$$HADD^XLFDT($H,,,2),ZTIO="",ZTSAVE("OUTNODE")=""
D ^%ZTLOAD
Q
ASSESSDQ ;SEND ASSESSMENT CHANGE NOTIFICATION
N DIC,X,GMRAL
M GMRAL=^XTMP("GMRAVPR",OUTNODE)
K ^XTMP("GMRAVPR",OUTNODE)
S DIC=101,X="GMRA ASSESSMENT CHANGE"
D EN^XQOR
I $O(^XTMP("GMRAVPR",0))="" K ^XTMP("GMRAVPR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAVPR 1613 printed Sep 23, 2025@19:16:44 Page 2
GMRAVPR ;ISP/RFR - VPR CALLS FOR ART ;Nov 06, 2020@15:40
+1 ;;4.0;Adverse Reaction Tracking;**53,64**;Mar 29, 1996;Build 2
+2 QUIT
ASSESS(OLDVAL,NEWVAL,DA,TYPE) ;NOTIFY SUBSCRIBERS OF ASSESSMENT CHANGES
+1 ;ALLOW THE SET CALL TO STORE THE DATA WHEN EDITING AN ENTRY
+2 ;DO NOT EXECUTE DURING A PRE-/POST-INSTALL OF THE RELATED INDEX
+3 IF (($GET(TYPE)="KILL")&($GET(NEWVAL(1))'=""))!($GET(XPDNM)'="")
QUIT
+4 NEW OUTNODE,ACTION,REFS,SUBS,REF,SUB,PIECE,ORDER,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+5 SET OUTNODE=$JOB_";"_DA
+6 IF $GET(TYPE)="SET"
SET ACTION=$SELECT($GET(OLDVAL(1))="":"CREATED",1:"MODIFIED")
+7 IF $GET(TYPE)="KILL"
SET ACTION="DELETED"
+8 IF ACTION="CREATED"
SET ^XTMP("GMRAVPR",OUTNODE,"BEFORE",0)=""
SET REFS="NEWVAL"
SET SUBS="AFTER"
+9 IF ACTION="MODIFIED"
SET REFS="OLDVAL"_U_"NEWVAL"
SET SUBS="BEFORE"_U_"AFTER"
+10 IF ACTION="DELETED"
SET ^XTMP("GMRAVPR",OUTNODE,"AFTER",0)=""
SET REFS="OLDVAL"
SET SUBS="BEFORE"
+11 SET ^XTMP("GMRAVPR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT_U_"Notify Subscribers of ART Assessment Change"
+12 SET ^XTMP("GMRAVPR",OUTNODE)=DA
+13 FOR PIECE=1:1
SET REF=$PIECE(REFS,U,PIECE)
if REF=""
QUIT
Begin DoDot:1
+14 SET SUB=$PIECE(SUBS,U,PIECE)
+15 SET ORDER=0
FOR
SET ORDER=$ORDER(@REF@(ORDER))
if '+ORDER
QUIT
Begin DoDot:2
+16 IF $GET(@REF@(ORDER))'=""
SET $PIECE(^XTMP("GMRAVPR",OUTNODE,SUB,0),U,ORDER)=$GET(@REF@(ORDER))
End DoDot:2
End DoDot:1
+17 SET ZTRTN="ASSESSDQ^GMRAVPR"
+18 SET ZTDESC="GMRA ADVERSE REACTION ASSESSMENT CHANGE NOTIFIER"
+19 SET ZTDTH=$$HADD^XLFDT($HOROLOG,,,2)
SET ZTIO=""
SET ZTSAVE("OUTNODE")=""
+20 DO ^%ZTLOAD
+21 QUIT
ASSESSDQ ;SEND ASSESSMENT CHANGE NOTIFICATION
+1 NEW DIC,X,GMRAL
+2 MERGE GMRAL=^XTMP("GMRAVPR",OUTNODE)
+3 KILL ^XTMP("GMRAVPR",OUTNODE)
+4 SET DIC=101
SET X="GMRA ASSESSMENT CHANGE"
+5 DO EN^XQOR
+6 IF $ORDER(^XTMP("GMRAVPR",0))=""
KILL ^XTMP("GMRAVPR")
+7 QUIT
