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

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

@@ -1 @@
-PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;08/16/2007
- ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1. ;09/20/2004
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  ;=====================================================
 CLIST(IEN) ;Build the list of components for the repository
@@ -98 +98 @@
  ;
  ;=====================================================
-DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN.
- N DA,DIK
- S DA=IHIEN,DA(1)=RIEN
- S DIK="^PXD(811.8,"_DA(1)_",130,"
- D ^DIK
+DELHIST(RIEN,IHIND) ;Delete install history IHIND in repository entry RIEN.
+ N DATE
+ S DATE=$P(^PXD(811.8,RIEN,130,IHIND,0),U)
+ K ^PXD(811.8,RIEN,130,IHIND)
+ K ^PXD(811.8,RIEN,130,"B",DATE)
  Q
  ;
@@ -146 +146 @@
 RIEN(LIEN) ;Given the list ien return the repository ien.
  N RIEN
- S RIEN=$G(^TMP("PXRMEXLR",$J,"SEL",LIEN))
+ S RIEN=$G(^TMP("PXRMEXLR",$J,"IDX",LIEN,LIEN))
  Q RIEN
  ;
  ;=====================================================
 SAVHIST ;Save the installation history in the repository.
- N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,NEWNAME
- N SUB,TEMP,TOTAL,TYPE,USER
+ N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,NEWNAME,TEMP,USER
  ;Find the first open spot in the Installation History node.
  S (IND,JND)=0
- F  S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(IND>JND)
+ F  S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(JND>IND)
+ ;Set the 0 node.
+ S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_JND_U_JND
  S IND=JND
- S JND=0
- F SUB="PXRMEXIA","PXRMEXIAD" D
- . S INDEX=0
- . F  S INDEX=$O(^TMP(SUB,$J,INDEX)) Q:+INDEX=0  D
- .. S JND=JND+1
- .. S CMPNT=$O(^TMP(SUB,$J,INDEX,""))
- .. S ITEM=$O(^TMP(SUB,$J,INDEX,CMPNT,""))
- .. S ACTION=$O(^TMP(SUB,$J,INDEX,CMPNT,ITEM,""))
- .. S NEWNAME=$G(^TMP(SUB,$J,INDEX,CMPNT,ITEM,ACTION))
- .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
- ..;Set the 0 node.
- .. S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
- ..;Check for finding item changes and save them.
- .. S FTYPE=""
- .. I CMPNT["DEFINITION" S FTYPE="DEFF"
- .. I CMPNT["DIALOG" S FTYPE="DIAF"
- .. I CMPNT["TERM" S FTYPE="TRMF"
- .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
- ... N FI,FINDING,KND,OFINDING
- ... S KND=2
- ... S FI=""
- ... F  S FI=$O(^TMP(SUB,$J,FTYPE,FI)) Q:FI=""  D
- .... S OFINDING=$O(^TMP(SUB,$J,FTYPE,FI,""))
- .... S FINDING=^TMP(SUB,$J,FTYPE,FI,OFINDING)
- .... I OFINDING=FINDING Q
+ S DATE=^TMP("PXRMEXIA",$J,"DT")
+ S USER=$$GET1^DIQ(200,DUZ,.01,"")
+ S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER
+ S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
+ S (INDEX,JND)=0
+ F  S INDEX=$O(^TMP("PXRMEXIA",$J,INDEX)) Q:+INDEX=0  D
+ . S JND=JND+1
+ . S CMPNT=$O(^TMP("PXRMEXIA",$J,INDEX,""))
+ . S ITEM=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,""))
+ . S ACTION=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,""))
+ . S NEWNAME=$G(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,ACTION))
+ . S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
+ .;Set the 0 node.
+ . S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
+ .;Check for finding item changes and save them.
+ . S FTYPE=""
+ . I CMPNT["DEFINITION" S FTYPE="DEFF"
+ . I CMPNT["DIALOG" S FTYPE="DIAF"
+ . I CMPNT["TERM" S FTYPE="TRMF"
+ . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D
+ .. N FI,FINDING,KND,OFINDING
+ .. S KND=2
+ .. S FI=""
+ .. F  S FI=$O(^TMP("PXRMEXIA",$J,FTYPE,FI)) Q:FI=""  D
+ ... S OFINDING=$O(^TMP("PXRMEXIA",$J,FTYPE,FI,""))
+ ... S FINDING=^TMP("PXRMEXIA",$J,FTYPE,FI,OFINDING)
+ ... I OFINDING=FINDING Q
+ ... S KND=KND+1
+ ... S TEMP=$E(OFINDING,1,33)
+ ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
+ .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
+ .. I KND>2 D
+ ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   Finding Changes"
+ ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)="     Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
+ .;
+ .;Check for TIU template replacements and save them.
+ . I CMPNT["DIALOG" S FTYPE="DIATIU"
+ . E  S FTYPE=""
+ . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D
+ .. N KND,OTIUT,TIUT,TYPE
+ .. S TYPE=""
+ .. S KND=2
+ .. F  S TYPE=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE)) Q:TYPE=""  D
+ ... S OTIUT=""
+ ... F  S OTIUT=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT)) Q:OTIUT=""  D
+ .... S TIUT=$G(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT))
+ .... I OTIUT=TIUT Q
+ .... I '$D(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT,ITEM)) Q
  .... S KND=KND+1
- .... S TEMP=$E(OFINDING,1,33)
- .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
+ .... S TEMP=$E(OTIUT,1,33)
+ .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
  ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
  ... I KND>2 D
- .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   Finding Changes"
+ .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   "_TYPE
  .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)="     Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
- ..;
- ..;Check for TIU template replacements and save them.
- .. I CMPNT["DIALOG" S FTYPE="DIATIU"
- .. E  S FTYPE=""
- .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
- ... N KND,OTIUT,TIUT,TYPE
- ... S TYPE=""
- ... S KND=2
- ... F  S TYPE=$O(^TMP(SUB,$J,FTYPE,TYPE)) Q:TYPE=""  D
- .... S OTIUT=""
- .... F  S OTIUT=$O(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) Q:OTIUT=""  D
- ..... S TIUT=$G(^TMP(SUB,$J,FTYPE,TYPE,OTIUT))
- ..... I OTIUT=TIUT Q
- ..... I '$D(^TMP(SUB,$J,FTYPE,TYPE,OTIUT,ITEM)) Q
- ..... S KND=KND+1
- ..... S TEMP=$E(OTIUT,1,33)
- ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
- .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
- .... I KND>2 D
- ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   "_TYPE
- ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)="     Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
- ;If JND is still 0 then there was nothing to save.
- I JND>0 D
- .;Save the header information.
- . S DATE=^TMP("PXRMEXIA",$J,"DT")
- . S TYPE=^TMP("PXRMEXIA",$J,"TYPE")
- . S USER=$$GET1^DIQ(200,DUZ,.01,"")
- . S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE
- . S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
- .;Set the 0 node.
- . S (KND,TOTAL)=0
- . F  S KND=+$O(^PXD(811.8,PXRMRIEN,130,KND)) Q:KND=0  S TOTAL=TOTAL+1
- . S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL
  K ^TMP("PXRMEXIA",$J)
- K ^TMP("PXRMEXIAD",$J)
- Q
- ;
+ Q
+ ;