Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXID.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/PXRMEXID.m (modified) (12 diffs)

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

@@ -1 @@
-PXRMEXID ;SLC/PJH - Reminder Dialog Exchange Install Routine.;08/16/2007
- ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+PXRMEXID ;SLC/PJH - Reminder Dialog Exchange Install Routine.;11/14/2003
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  ;
  ;==================================================
@@ -7 +7 @@
  ;------------------------------------------------
 INSALL N ALL,DIROUT,DIRUT,DTOUT,DUOUT,IND,PXRMDONE
+ K ^TMP("PXRMEXIA",$J)
  ;
  ;Set the install date and time.
- S IND="",PXRMDONE=0
+ S IND="",PXRMDONE=0,^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
  ;
  ;Go to full screen mode.
@@ -18 +19 @@
  S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM"))
  D EXIST^PXRMEXIX(.ALL,DNAME,"reminder dialog","")
- I ALL=0 D DISP^PXRMEXLD(PXRMMODE) Q
  ;
  ;Lock the entire file
  Q:'$$LOCK
- F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE)  D
+ ;
+ ;Install all components
+ F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(+IND=0)!(PXRMDONE)  D
  .D INSCOM(IND,1)
  ;
@@ -41 +43 @@
  F  S ISEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:'ISEQ  D
  .S IDATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:IDATA=""
- .S DNAME=$P(IDATA,U) Q:DNAME=""
- .;
- .I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D
- ..S REPL=$$CHKREPL^PXRMEXD1(NAME) I REPL>0 D INSREPL(NAME,REPL,.INAME)
- .S INAME(DNAME)=""
- .;Q:$$PXRM(DNAME)  S INAME(DNAME)=""
+ .S DNAME=$P(IDATA,U) Q:DNAME=""  Q:$$PXRM(DNAME)  S INAME(DNAME)=""
  .;Check for descendants
  .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
- Q
- ;Build list of replacement names
- ;-------------------------------
-INSREPL(NAME,REPL,INAME) ;
- N DNAME,IDATA,ISEQ
- S ISEQ=0
- S IDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",REPL,NAME)) Q:IDATA=""
- S DNAME=$P(IDATA,U) Q:DNAME=""  S INAME(DNAME)=""
- ;S DNAME=$P(IDATA,U) Q:DNAME=""  Q:$$PXRM(DNAME)  S INAME(DNAME)=""
- ;Check for descendants
- I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
  Q
  ;
@@ -65 +51 @@
  ;---------------------
 INSCOM(IND,SILENT) ;
- N ACTION,ATTR,CSUM,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
- N NEWPT01,PT01,START,REPL,SAME,TEMP
+ N ACTION,ATTR,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
+ N NEWPT01,PT01,START,TEMP
  S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),FILENUM=$P(TEMP,U,1)
  S EXISTS=$P(TEMP,U,4),START=$P(TEMP,U,2),END=$P(TEMP,U,3) Q:START=""
@@ -79 +65 @@
  ;
  ;Check for descendents
- S REPL=$$CHKREPL^PXRMEXD1(PT01)
- I 'SILENT&($$INSDSC(PT01)!(REPL>0)) D  Q:PXRMDONE
+ I 'SILENT,$$INSDSC(PT01) D  Q:PXRMDONE
  .N ANS,INDS,TEXT
  .S TEXT(1)=PT01_" ("_DTYP_") contains sub-components."
@@ -86 +71 @@
  .;Give option to install all descendents
  .D ASK^PXRMEXIX(.ANS,.TEXT,1) Q:PXRMDONE
- .I $G(ANS)="N" S PXRMDONE=1 Q
  .I $G(ANS)="Y" D
  ..S INDS=IND
  ..N IDATA,INAME,IND
- ..I REPL>0 D INSREPL(PT01,REPL,.INAME)
  ..;Build list of decendents to install
  ..D INSBLD(PT01,.INAME)
@@ -106 +89 @@
  ...I $D(INAME(PT01)) D INSCOM(IND,1)
  ;
-SETENTRY ;
- D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
- S ACTION=""
+ D SETATTR^PXRMEXFI(.ATTR,FILENUM)
  ;Double check that it hasn't been installed
  S EXIEN=$$EXISTS^PXRMEXIU(801.41,PT01)
  I EXIEN,'EXISTS S EXISTS=1
- I EXISTS D
- . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
- . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXIEN)
- . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
- . I SAME D FEIMSG^PXRMEXFI(SAME,.ATTR) S ACTION="S",(PXRMNMCH,NEWPT01)=""
- I ACTION="" D
- .;If all components installed the default is 'Install or Overwrite'
- . S:ALL ACTION=$S(EXISTS:"O",1:"I"),(PXRMNMCH,NEWPT01)=""
- . S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXIEN)
+ ;If all components installed the default is 'Install or Overwrite'
+ S:ALL ACTION=$S(EXISTS:"O",1:"I"),(ATTR("NAME"),ATTR("PT01"))=PT01,PXRMNMCH="",NEWPT01=""
+ S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXISTS)
  ;Save what was done for the installation summary.
- S ^TMP("PXRMEXIAD",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
+ S ^TMP("PXRMEXIA",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
  ;Clear heading
  S VALMHDR(2)=""
@@ -152 +127 @@
  F  S SUB=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:'SUB  D  Q:DFOUND
  .S DATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:DATA=""
- .S DFOUND=1
- .;I '$$PXRM($P(DATA,U)) S DFOUND=1
+ .I '$$PXRM($P(DATA,U)) S DFOUND=1
  Q DFOUND
  ;
-INSREPL1(NAME) ;
- N DATA,DFOUND,SUB
- S DFOUND=0,SUB=0
- F  S SUB=$O(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:'SUB  D  Q:DFOUND
- .S DATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:DATA=""
- .S DFOUND=1
- Q DFOUND
  ;Option to link dialog to a reminder
  ;-----------------------------------
@@ -223 +190 @@
  D EN^VALM2(XQORNOD(0))
  ;
+ K ^TMP("PXRMEXIA",$J)
  ;Set the install date and time.
- S ALL="",PXRMDONE=0
+ S ALL="",PXRMDONE=0,^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
  ;
  ;Lock the entire file
@@ -230 +198 @@
  ;
  S IND=0
- F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D INSCOM(IND,0)
+ F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
+ .D INSCOM(IND,0)
  ;
  ;Clear locks
@@ -255 +224 @@
  ;Ignore non-PXRM
  I $E(NAME,1,4)'="PXRM" Q 0
- N DIEN,RESULT
- I $G(PXRMINST)=1 D  Q RESULT
- .S RESULT=0
- .S DIEN=$O(^PXRMD(801.41,"B",NAME,"")) I 'DIEN Q
- .I $P($G(^PXRMD(801.41,DIEN,100)),U)'="N" Q
- .I ($P($G(^PXRMD(801.41,DIEN,0)),U,4)="P")!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="F") S RESULT=1
  ;
  ;Check if this is a national code
+ N DIEN
  S DIEN=$O(^PXRMD(801.41,"B",NAME,""))
  ;If not found abort
  I 'DIEN Q 0
- ;if result group/element quit
- I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="S"!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="T") Q 0
  ;Check class
  I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q 1