Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_REMINDERS-PXRM/PXRMEXU4.m (modified) (3 diffs)

FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m

@@ -1 @@
-PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;05/16/2007
- ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;01/19/2005
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  ;===============================================
 DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by
@@ -15 +15 @@
  D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
  ;Plus field 15 files
- ;S ALIST("MH")=601,ALIST("TX")=811.2
- S ALIST("MH")=601.71,ALIST("TX")=811.2
+ S ALIST("MH")=601,ALIST("TX")=811.2
  S ALIST("WH")=790.404
  ;Plus field 17 file
@@ -186 +185 @@
  .. I Y="" S ACTION="Q" Q
  .. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2)
- ;Process Result Groups
- F  S IENS=$O(FDA(801.41121,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
- . S PT01=$G(FDA(801.41121,IENS,.01)) Q:PT01=""
- . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
- .I NEWNAM'="" D
- .. S FDA(801.41121,IENS,2)=NEWNAM,PT01=NEWNAM
- .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
- .I IEN=0 D
- ..;Get replacement
- .. N DIC,DIR,DUOUT,MSG,X,Y
- .. S MSG(1)=" "
- .. S MSG(2)="RESULT GROUP entry "_PT01_" does not exist."
- .. D MES^XPDUTL(.MSG)
- .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
- .. I ACTION="S" S ACTION="Q"
- .. I ACTION="Q" Q
- .. I ACTION="D" K FDA(801.41121,IENS) Q
- .. S DIC=FILENUM
- .. S DIC(0)="AEMNQ"
- .. S DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)"
- .. S Y=-1
- .. F  Q:+Y'=-1  D
- ...;If this is being called during a KIDS install we need echoing on.
- ... I $D(XPDNM) X ^%ZOSF("EON")
- ... D ^DIC
- ... I $D(XPDNM) X ^%ZOSF("EOFF")
- ... I $D(DUOUT) S Y="" Q
- ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
- .. I Y="" S ACTION="Q" Q
- .. I Y'="" S FDA(801.41121,IENS,.01)=$P(Y,U,2)
  Q
  ;