PXRMPSN ;SLC/PKR - Process PSN protocol events. ;04/21/2016 15:14
;;2.0;CLINICAL REMINDERS;**12,17,16,18,22,45**;Feb 04, 2005;Build 566
;==============================
DEF(FILENUM,GBL,FIEN,NL) ;Write out the list of definintions using this
;finding.
N DEF,FI,IEN,START
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="in the following reminder definitions:"
I '$D(^TMP($J,"FDATA",FILENUM,FIEN,"DEF")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S (IEN,START)=0
F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,"DEF",IEN)) Q:IEN="" D
. S DEF=$P(^PXD(811.9,IEN,0),U,1)
. I START>0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_DEF_" (IEN="_IEN_")"
. S FI="",START=1
. F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,"DEF",IEN,FI)) Q:FI="" D
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Finding number "_FI
Q
;
;==============================
EVDRVR ;Event driver for PSN events.
;STRUCTURE OF MESSAGE
;^TMP("PSN",$J,VA PRODUCT IEN,0)=VA PRODUCT IEN^OLD DRUG CLASS IEN^
;NEW DRUG CLASS IEN^VA GENERIC IEN^VA GENERIC NAME
N DEFL,FILENUM,FILES,GBL,NEWDCIEN,NEWDCNAM,NL,NHL,OLDDCIEN,OLDDCNAM
N SUBJECT,TEMP,VAGIEN,VAGNAM,VAPROD,VAPRODIEN
S ZTREQ="@"
K ^TMP($J,"FDATA"),^TMP("PXRMXMZ",$J)
S NL=1,^TMP("PXRMXMZ",$J,NL,0)="NDF Drug Class update"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Review each of the entries to determine if you need to:"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" * Add the new drug class to the reminder definition/term"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" * Change the finding to use the new drug class instead"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" * In some cases, no change will be clinically necessary"
;Save the number of lines in the header.
S NHL=NL
;
S VAPRODIEN=0
F S VAPRODIEN=$O(^XTMP(EVENT,VAPRODIEN)) Q:VAPRODIEN="" D
. S TEMP=^XTMP(EVENT,VAPRODIEN,0)
. S OLDDCIEN=$P(TEMP,U,2)
. S NEWDCIEN=$P(TEMP,U,3)
. S VAGIEN=$P(TEMP,U,4)
. S VAGNAM=$P(TEMP,U,5)
.;DBIA #2574
. S VAPROD=$$PROD0^PSNAPIS(VAPRODIEN,VAPRODIEN)
. S OLDDCNAM=$$CLASS2^PSNAPIS(OLDDCIEN)
. S NEWDCNAM=$$CLASS2^PSNAPIS(NEWDCIEN)
. S OLDDCNAM=$$STRREP^PXRMUTIL(OLDDCNAM,"^",", ")
. S NEWDCNAM=$$STRREP^PXRMUTIL(NEWDCNAM,"^",", ")
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="-------------------------------------------------------"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="VA PRODUCT: "_$P(VAPROD,U,1)_" (IEN="_VAPRODIEN_")"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Has moved from drug class "_OLDDCNAM_", (IEN="_OLDDCIEN_")"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" to drug class "_NEWDCNAM_", (IEN="_NEWDCIEN_")"
.;Process the lists, and generate a MailMan message.
. K ^TMP($J,"FDATA")
. D DEFLIST^PXRMFRPT(50.605,"PS(50.605,",OLDDCIEN,"FDATA")
. D DEF(50.605,"PS(50.605,",OLDDCIEN,.NL)
. D TERMLIST^PXRMFRPT(50.605,"PS(50.605,",OLDDCIEN,"FDATA")
. D TERM(50.605,"PS(50.605,",OLDDCIEN,.NL)
. D ROC(50.605,"PS(60.605,",OLDDCIEN,.NL)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="VA GENERIC "_VAGNAM_" is used directly"
. D DEFLIST^PXRMFRPT(50.6,"PSNDF(50.6,",VAGIEN,"FDATA")
. D DEF(50.6,"PSNDF(50.6,",VAGIEN,.NL)
. D TERMLIST^PXRMFRPT(50.6,"PSNDF(50.6,",VAGIEN,"FDATA")
. D TERM(50.6,"PSNDF(50.6,",VAGIEN,.NL)
;Do not send the message if it only contains the header.
I NL>NHL D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Check your reminder definitions and terms to be sure the change in"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="drug class does not require adjustment to them."
. S SUBJECT="Clinical Reminder Drug Class Update from National Drug File"
. D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
K ^TMP($J,"FDATA"),^TMP("PXRMXMZ",$J),^XTMP(EVENT)
Q
;
;==============================
PSNEVENT ;Handle PSN events. This routine is attached to the PSN NEW CLASS
;protocol through the PXRM PSN EVENT protocol.
N EVENT,SUBJECT
S EVENT="PXRM PSN EVENT"_$$NOW^XLFDT
K ^XTMP(EVENT)
;STRUCTURE OF MESSAGE
;^TMP($J,VA PRODUCT IEN,0)=VA PRODUCT IEN^OLD DRUG CLASS IEN^
;NEW DRUG CLASS IEN^VA GENERIC IEN^VA GENERIC NAME
S ^XTMP(EVENT,0)=$$FMADD^XLFDT(DT,3)_U_DT
M ^XTMP(EVENT)=^TMP("PSN",$J)
S SUBJECT="Clinical Reminders PSN protocol event"
;Task off the work and return to the protocol.
K ZTSAVE
S ZTSAVE("EVENT")=""
S ZTSAVE("SUBJECT")=""
S ZTRTN="EVDRVR^PXRMPSN"
S ZTDESC="Clinical Reminders PSN event handler"
S ZTDTH=$H
S ZTIO=""
D ^%ZTLOAD
Q
;
;==============================
ROC(FILENUM,GBL,FIEN,NL) ;Search all reminder order checks for any
;that are using this finding, defined by the global (GBL) and the
;IEN (FIEN). Should only be called for Drug Class findings.
N IEN,NAME,START
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="and the following reminder order check groups:"
I '$D(^PXD(801,"OCI",FIEN_";PSNDF(50.605,")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S (IEN,START)=0
F S IEN=$O(^PXD(801,"OCI",FIEN_";PSNDF(50.605,",IEN)) Q:IEN'>0 D
. S NAME=$P($G(^PXD(801,IEN,0)),U) I NAME="" Q
. I START>0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_NAME_" (IEN="_IEN_")"
. S START=1
Q
;
;==============================
TERM(FILENUM,GBL,FIEN,NL) ;Search all reminder terms for any
;that are using this finding, defined by the global (GBL) and the
;IEN (FIEN).
N FI,IEN,START,TERM
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="and the following reminder terms:"
I '$D(^TMP($J,"FDATA",FILENUM,FIEN,"TERM")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S (IEN,START)=0
F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,"TERM",IEN)) Q:IEN="" D
. S TERM=$P(^PXRMD(811.5,IEN,0),U,1)
. I START>0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_TERM_" (IEN="_IEN_")"
. S FI="",START=1
. F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,"TERM",IEN,FI)) Q:FI="" D
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Finding number "_FI
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPSN 6086 printed Apr 09, 2024@20:50:04 Page 2
PXRMPSN ;SLC/PKR - Process PSN protocol events. ;04/21/2016 15:14
+1 ;;2.0;CLINICAL REMINDERS;**12,17,16,18,22,45**;Feb 04, 2005;Build 566
+2 ;==============================
DEF(FILENUM,GBL,FIEN,NL) ;Write out the list of definintions using this
+1 ;finding.
+2 NEW DEF,FI,IEN,START
+3 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="in the following reminder definitions:"
+5 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+6 SET (IEN,START)=0
+7 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF",IEN))
if IEN=""
QUIT
Begin DoDot:1
+8 SET DEF=$PIECE(^PXD(811.9,IEN,0),U,1)
+9 IF START>0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_DEF_" (IEN="_IEN_")"
+11 SET FI=""
SET START=1
+12 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF",IEN,FI))
if FI=""
QUIT
Begin DoDot:2
+13 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Finding number "_FI
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
+16 ;==============================
EVDRVR ;Event driver for PSN events.
+1 ;STRUCTURE OF MESSAGE
+2 ;^TMP("PSN",$J,VA PRODUCT IEN,0)=VA PRODUCT IEN^OLD DRUG CLASS IEN^
+3 ;NEW DRUG CLASS IEN^VA GENERIC IEN^VA GENERIC NAME
+4 NEW DEFL,FILENUM,FILES,GBL,NEWDCIEN,NEWDCNAM,NL,NHL,OLDDCIEN,OLDDCNAM
+5 NEW SUBJECT,TEMP,VAGIEN,VAGNAM,VAPROD,VAPRODIEN
+6 SET ZTREQ="@"
+7 KILL ^TMP($JOB,"FDATA"),^TMP("PXRMXMZ",$JOB)
+8 SET NL=1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="NDF Drug Class update"
+9 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Review each of the entries to determine if you need to:"
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" * Add the new drug class to the reminder definition/term"
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" * Change the finding to use the new drug class instead"
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" * In some cases, no change will be clinically necessary"
+13 ;Save the number of lines in the header.
+14 SET NHL=NL
+15 ;
+16 SET VAPRODIEN=0
+17 FOR
SET VAPRODIEN=$ORDER(^XTMP(EVENT,VAPRODIEN))
if VAPRODIEN=""
QUIT
Begin DoDot:1
+18 SET TEMP=^XTMP(EVENT,VAPRODIEN,0)
+19 SET OLDDCIEN=$PIECE(TEMP,U,2)
+20 SET NEWDCIEN=$PIECE(TEMP,U,3)
+21 SET VAGIEN=$PIECE(TEMP,U,4)
+22 SET VAGNAM=$PIECE(TEMP,U,5)
+23 ;DBIA #2574
+24 SET VAPROD=$$PROD0^PSNAPIS(VAPRODIEN,VAPRODIEN)
+25 SET OLDDCNAM=$$CLASS2^PSNAPIS(OLDDCIEN)
+26 SET NEWDCNAM=$$CLASS2^PSNAPIS(NEWDCIEN)
+27 SET OLDDCNAM=$$STRREP^PXRMUTIL(OLDDCNAM,"^",", ")
+28 SET NEWDCNAM=$$STRREP^PXRMUTIL(NEWDCNAM,"^",", ")
+29 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+30 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="-------------------------------------------------------"
+31 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="VA PRODUCT: "_$PIECE(VAPROD,U,1)_" (IEN="_VAPRODIEN_")"
+32 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Has moved from drug class "_OLDDCNAM_", (IEN="_OLDDCIEN_")"
+33 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" to drug class "_NEWDCNAM_", (IEN="_NEWDCIEN_")"
+34 ;Process the lists, and generate a MailMan message.
+35 KILL ^TMP($JOB,"FDATA")
+36 DO DEFLIST^PXRMFRPT(50.605,"PS(50.605,",OLDDCIEN,"FDATA")
+37 DO DEF(50.605,"PS(50.605,",OLDDCIEN,.NL)
+38 DO TERMLIST^PXRMFRPT(50.605,"PS(50.605,",OLDDCIEN,"FDATA")
+39 DO TERM(50.605,"PS(50.605,",OLDDCIEN,.NL)
+40 DO ROC(50.605,"PS(60.605,",OLDDCIEN,.NL)
+41 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+42 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="VA GENERIC "_VAGNAM_" is used directly"
+43 DO DEFLIST^PXRMFRPT(50.6,"PSNDF(50.6,",VAGIEN,"FDATA")
+44 DO DEF(50.6,"PSNDF(50.6,",VAGIEN,.NL)
+45 DO TERMLIST^PXRMFRPT(50.6,"PSNDF(50.6,",VAGIEN,"FDATA")
+46 DO TERM(50.6,"PSNDF(50.6,",VAGIEN,.NL)
End DoDot:1
+47 ;Do not send the message if it only contains the header.
+48 IF NL>NHL
Begin DoDot:1
+49 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+50 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Check your reminder definitions and terms to be sure the change in"
+51 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="drug class does not require adjustment to them."
+52 SET SUBJECT="Clinical Reminder Drug Class Update from National Drug File"
+53 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
End DoDot:1
+54 KILL ^TMP($JOB,"FDATA"),^TMP("PXRMXMZ",$JOB),^XTMP(EVENT)
+55 QUIT
+56 ;
+57 ;==============================
PSNEVENT ;Handle PSN events. This routine is attached to the PSN NEW CLASS
+1 ;protocol through the PXRM PSN EVENT protocol.
+2 NEW EVENT,SUBJECT
+3 SET EVENT="PXRM PSN EVENT"_$$NOW^XLFDT
+4 KILL ^XTMP(EVENT)
+5 ;STRUCTURE OF MESSAGE
+6 ;^TMP($J,VA PRODUCT IEN,0)=VA PRODUCT IEN^OLD DRUG CLASS IEN^
+7 ;NEW DRUG CLASS IEN^VA GENERIC IEN^VA GENERIC NAME
+8 SET ^XTMP(EVENT,0)=$$FMADD^XLFDT(DT,3)_U_DT
+9 MERGE ^XTMP(EVENT)=^TMP("PSN",$JOB)
+10 SET SUBJECT="Clinical Reminders PSN protocol event"
+11 ;Task off the work and return to the protocol.
+12 KILL ZTSAVE
+13 SET ZTSAVE("EVENT")=""
+14 SET ZTSAVE("SUBJECT")=""
+15 SET ZTRTN="EVDRVR^PXRMPSN"
+16 SET ZTDESC="Clinical Reminders PSN event handler"
+17 SET ZTDTH=$HOROLOG
+18 SET ZTIO=""
+19 DO ^%ZTLOAD
+20 QUIT
+21 ;
+22 ;==============================
ROC(FILENUM,GBL,FIEN,NL) ;Search all reminder order checks for any
+1 ;that are using this finding, defined by the global (GBL) and the
+2 ;IEN (FIEN). Should only be called for Drug Class findings.
+3 NEW IEN,NAME,START
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="and the following reminder order check groups:"
+6 IF '$DATA(^PXD(801,"OCI",FIEN_";PSNDF(50.605,"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+7 SET (IEN,START)=0
+8 FOR
SET IEN=$ORDER(^PXD(801,"OCI",FIEN_";PSNDF(50.605,",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 SET NAME=$PIECE($GET(^PXD(801,IEN,0)),U)
IF NAME=""
QUIT
+10 IF START>0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_NAME_" (IEN="_IEN_")"
+12 SET START=1
End DoDot:1
+13 QUIT
+14 ;
+15 ;==============================
TERM(FILENUM,GBL,FIEN,NL) ;Search all reminder terms for any
+1 ;that are using this finding, defined by the global (GBL) and the
+2 ;IEN (FIEN).
+3 NEW FI,IEN,START,TERM
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="and the following reminder terms:"
+6 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+7 SET (IEN,START)=0
+8 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM",IEN))
if IEN=""
QUIT
Begin DoDot:1
+9 SET TERM=$PIECE(^PXRMD(811.5,IEN,0),U,1)
+10 IF START>0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_TERM_" (IEN="_IEN_")"
+12 SET FI=""
SET START=1
+13 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM",IEN,FI))
if FI=""
QUIT
Begin DoDot:2
+14 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Finding number "_FI
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
