Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAVPR

GMRAVPR.m

Go to the documentation of this file.
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