- PXRMP4EC ; SLC/PKR - PXRM*2.0*4 environment check. ;03/15/2005
- ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- ;
- ;===============================================================
- ENVCHK ;Perform an environment check. Look for any reminders still using
- ;old-style MRD. Do not install if any are found.
- N NL,TEXT
- D FOMRD(.NL)
- I NL>2 S XPDABORT=1
- I $G(XPDABORT) D
- . S TEXT(1)="Patch PXRM*2*4 cannot be installed because some reminders are still using"
- . S TEXT(2)="the old-style MRD. A message is being sent to the reminders mailgroup that"
- . S TEXT(3)="lists the reminders still using the old-style MRD. Please replace the old-style"
- . S TEXT(4)="MRD with a function finding."
- . D EN^DDIOL(.TEXT)
- E D
- . S TEXTI(1)="Environment check passed, ok to install patch PXRM*2*4"
- . D EN^DDIOL(.TEXT)
- Q
- ;
- ;===============================================================
- FOMRD(NL) ;Flag all definitions using the old-style MRD.
- N CPCL,IEN,NAME,XMSUB
- K ^TMP("PXRMXMZ",$J)
- S XMSUB="Old-style MRD obsolete"
- S ^TMP("PXRMXMZ",$J,1,0)="The following reminder definitions use the old-style MRD function;"
- S ^TMP("PXRMXMZ",$J,2,0)="please change them to use a function finding."
- S NL=2
- S IEN=0
- F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
- . S CPCL=$G(^PXD(811.9,IEN,30))
- . I CPCL'["MRD" Q
- . S NAME=$P(^PXD(811.9,IEN,0),U,1)
- . S NL=NL+1
- . S ^TMP("PXRMXMZ",$J,NL,0)=" "
- . S NL=NL+1
- . S ^TMP("PXRMXMZ",$J,NL,0)="Reminder: "_NAME_", ien - "_IEN
- . S NL=NL+1
- . S ^TMP("PXRMXMZ",$J,NL,0)="Custom cohort logic: "_CPCL
- I NL=2 K ^TMP("PXRMXMZ",$J) Q
- D SEND^PXRMMSG(XMSUB)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP4EC 1630 printed Feb 18, 2025@23:14:10 Page 2
- PXRMP4EC ; SLC/PKR - PXRM*2.0*4 environment check. ;03/15/2005
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +2 ;
- +3 ;===============================================================
- ENVCHK ;Perform an environment check. Look for any reminders still using
- +1 ;old-style MRD. Do not install if any are found.
- +2 NEW NL,TEXT
- +3 DO FOMRD(.NL)
- +4 IF NL>2
- SET XPDABORT=1
- +5 IF $GET(XPDABORT)
- Begin DoDot:1
- +6 SET TEXT(1)="Patch PXRM*2*4 cannot be installed because some reminders are still using"
- +7 SET TEXT(2)="the old-style MRD. A message is being sent to the reminders mailgroup that"
- +8 SET TEXT(3)="lists the reminders still using the old-style MRD. Please replace the old-style"
- +9 SET TEXT(4)="MRD with a function finding."
- +10 DO EN^DDIOL(.TEXT)
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET TEXTI(1)="Environment check passed, ok to install patch PXRM*2*4"
- +13 DO EN^DDIOL(.TEXT)
- End DoDot:1
- +14 QUIT
- +15 ;
- +16 ;===============================================================
- FOMRD(NL) ;Flag all definitions using the old-style MRD.
- +1 NEW CPCL,IEN,NAME,XMSUB
- +2 KILL ^TMP("PXRMXMZ",$JOB)
- +3 SET XMSUB="Old-style MRD obsolete"
- +4 SET ^TMP("PXRMXMZ",$JOB,1,0)="The following reminder definitions use the old-style MRD function;"
- +5 SET ^TMP("PXRMXMZ",$JOB,2,0)="please change them to use a function finding."
- +6 SET NL=2
- +7 SET IEN=0
- +8 FOR
- SET IEN=+$ORDER(^PXD(811.9,IEN))
- if IEN=0
- QUIT
- Begin DoDot:1
- +9 SET CPCL=$GET(^PXD(811.9,IEN,30))
- +10 IF CPCL'["MRD"
- QUIT
- +11 SET NAME=$PIECE(^PXD(811.9,IEN,0),U,1)
- +12 SET NL=NL+1
- +13 SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "
- +14 SET NL=NL+1
- +15 SET ^TMP("PXRMXMZ",$JOB,NL,0)="Reminder: "_NAME_", ien - "_IEN
- +16 SET NL=NL+1
- +17 SET ^TMP("PXRMXMZ",$JOB,NL,0)="Custom cohort logic: "_CPCL
- End DoDot:1
- +18 IF NL=2
- KILL ^TMP("PXRMXMZ",$JOB)
- QUIT
- +19 DO SEND^PXRMMSG(XMSUB)
- +20 QUIT
- +21 ;
