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