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.
  1. 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
  1. Q
  1. ASSESS(OLDVAL,NEWVAL,DA,TYPE) ;NOTIFY SUBSCRIBERS OF ASSESSMENT CHANGES
  1. ;ALLOW THE SET CALL TO STORE THE DATA WHEN EDITING AN ENTRY
  1. ;DO NOT EXECUTE DURING A PRE-/POST-INSTALL OF THE RELATED INDEX
  1. I (($G(TYPE)="KILL")&($G(NEWVAL(1))'=""))!($G(XPDNM)'="") Q
  1. N OUTNODE,ACTION,REFS,SUBS,REF,SUB,PIECE,ORDER,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1. S OUTNODE=$J_";"_DA
  1. I $G(TYPE)="SET" S ACTION=$S($G(OLDVAL(1))="":"CREATED",1:"MODIFIED")
  1. I $G(TYPE)="KILL" S ACTION="DELETED"
  1. I ACTION="CREATED" S ^XTMP("GMRAVPR",OUTNODE,"BEFORE",0)="",REFS="NEWVAL",SUBS="AFTER"
  1. I ACTION="MODIFIED" S REFS="OLDVAL"_U_"NEWVAL",SUBS="BEFORE"_U_"AFTER"
  1. I ACTION="DELETED" S ^XTMP("GMRAVPR",OUTNODE,"AFTER",0)="",REFS="OLDVAL",SUBS="BEFORE"
  1. S ^XTMP("GMRAVPR",0)=$$FMADD^XLFDT(DT,1)_U_$$DT^XLFDT_U_"Notify Subscribers of ART Assessment Change"
  1. S ^XTMP("GMRAVPR",OUTNODE)=DA
  1. F PIECE=1:1 S REF=$P(REFS,U,PIECE) Q:REF="" D
  1. .S SUB=$P(SUBS,U,PIECE)
  1. .S ORDER=0 F S ORDER=$O(@REF@(ORDER)) Q:'+ORDER D
  1. ..I $G(@REF@(ORDER))'="" S $P(^XTMP("GMRAVPR",OUTNODE,SUB,0),U,ORDER)=$G(@REF@(ORDER))
  1. S ZTRTN="ASSESSDQ^GMRAVPR"
  1. S ZTDESC="GMRA ADVERSE REACTION ASSESSMENT CHANGE NOTIFIER"
  1. S ZTDTH=$$HADD^XLFDT($H,,,2),ZTIO="",ZTSAVE("OUTNODE")=""
  1. D ^%ZTLOAD
  1. Q
  1. ASSESSDQ ;SEND ASSESSMENT CHANGE NOTIFICATION
  1. N DIC,X,GMRAL
  1. M GMRAL=^XTMP("GMRAVPR",OUTNODE)
  1. K ^XTMP("GMRAVPR",OUTNODE)
  1. S DIC=101,X="GMRA ASSESSMENT CHANGE"
  1. D EN^XQOR
  1. I $O(^XTMP("GMRAVPR",0))="" K ^XTMP("GMRAVPR")
  1. Q