Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMEXLI

PXRMEXLI.m

Go to the documentation of this file. 
  1. PXRMEXLI ; SLC/PKR - List Manager routines for repository entry install. ;06/30/2020
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,45,42**;Feb 04, 2005;Build 245
  1.  ;
  1.  ;====================
  1. EXIT ;Finish the install.
  1.  D HFCAT
  1.  ;Clean-up ^TMP.
  1.  K ^TMP($J,"HFCAT"),^TMP("PXRMEXLC",$J),^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J)
  1.  Q
  1.  ;
  1.  ;====================
  1. HFCAT ;Check for category health factors that need to be renamed or repointed.
  1.  ;Category names must end with "[C]".
  1.  N CEXISTS,CNAME,EXISTS,HFNAME,L3C,LEN,PXNAT,TEXT
  1.  ;National health factor categories need to have the '[C]' appended.
  1.  S PXNAT=1
  1.  S HFNAME=""
  1.  F  S HFNAME=$O(^TMP($J,"HFCAT",HFNAME)) Q:HFNAME=""  D
  1.  . S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
  1.  . I L3C="[C]" Q
  1.  . S CNAME=HFNAME_" [C]"
  1.  . S CEXISTS=+$$EXISTS^PXRMEXIU(9999999.64,CNAME)
  1.  . I CEXISTS D  Q
  1.  .. D HFCLASS(CEXISTS,PXRMNAT)
  1.  .. K TEXT
  1.  .. S TEXT(1)=""
  1.  .. S TEXT(2)="Changing pointers to category health factor "_HFNAME
  1.  .. S TEXT(3)="to point to "_CNAME
  1.  .. S TEXT(4)="and deleting "_HFNAME
  1.  .. D MSG(.TEXT)
  1.  .. D HFCRPT(HFNAME,CNAME)
  1.  . K TEXT
  1.  . S TEXT(1)=""
  1.  . S TEXT(2)="Renaming category health factor "_HFNAME
  1.  . S TEXT(3)="to "_CNAME
  1.  . D MSG(.TEXT)
  1.  . D RENAME^PXRMUTIL(9999999.64,HFNAME,CNAME)
  1.  Q
  1.  ;
  1.  ;====================
  1. HFCLASS(CIEN,PXRMNAT) ;Check the class of the category health factor and
  1.  ;if PXNAT=1 make sure it is national.
  1.  N CLASS
  1.  S CLASS=$P(^AUTTHF(CIEN,100),U,1)
  1.  I (PXRMNAT=1)&(CLASS="N") Q
  1.  I PXRMNAT=1 S $P(^AUTTHF(CIEN,100),U,1)="N"
  1.  Q
  1.  ;
  1.  ;====================
  1. HFCRPT(HFNAME,CNAME) ;Repoint a category health factor.
  1.  ;All health factors in a category.
  1.  N FDA,HFIEN,IEN,IENS,MSG,TEXT
  1.  S HFIEN=+$$EXISTS^PXRMEXIU(9999999.64,HFNAME)
  1.  I HFIEN=0 Q
  1.  S IEN=""
  1.  F  S IEN=+$O(^AUTTHF("AC",HFIEN,IEN)) Q:IEN=0  D
  1.  . K TEXT
  1.  . S TEXT(1)=""
  1.  . S TEXT(2)="Changing the category of health factor "_$P(^AUTTHF(IEN,0),U,1)
  1.  . S TEXT(3)=" from "_HFNAME
  1.  . S TEXT(4)=" to "_CNAME
  1.  . D MSG(.TEXT)
  1.  . S FDA(9999999.64,IEN_",",.03)=CNAME
  1.  . D FILE^DIE("ET","FDA","MSG")
  1.  . I $D(MSG) D
  1.  .. K TEXT
  1.  .. S TEXT(1)=""
  1.  .. S TEXT(2)="There was an error changing the category"
  1.  .. S TEXT(3)="the FileMan error message is:"
  1.  .. D EN^DDIOL(.TEXT)
  1.  .. D AWRITE^PXRMUTIL("MSG") H 3
  1.  ;
  1.  ;Health Summaries using the component PCE Health Factors Selected.
  1.  D HSHFCAT(HFIEN,CNAME)
  1.  ;
  1.  ;Delete the original health factor.
  1.  S FDA(9999999.64,HFIEN_",",.01)="@"
  1.  D FILE^DIE("ET","FDA","MSG")
  1.  I $D(MSG) D
  1.  . K TEXT
  1.  . S TEXT(1)=""
  1.  . S TEXT(2)="There was an error deleting the category health factor:"
  1.  . S TEXT(3)=HFNAME
  1.  . S TEXT(4)="the FileMan error message is:"
  1.  . D EN^DDIOL(.TEXT)
  1.  . D AWRITE^PXRMUTIL("MSG") H 3
  1.  Q
  1.  ;
  1.  ;====================
  1. HSHFCAT(HFIEN,CNAME) ;Search the Health Summary Type file for Selection Items
  1.  ;that match HFIEN and replace it with CNAME.
  1.  ;are health factor categories.
  1.  N D0,D1,D2,FDA,IENS,MSG,SELITEM,TEXT,VP
  1.  S VP=HFIEN_";AUTTHF("
  1.  S D0=0
  1.  F  S D0=+$O(^GMT(142,D0)) Q:D0=0  D
  1.  . S D1=0
  1.  . F  S D1=+$O(^GMT(142,D0,1,D1)) Q:D1=0  D
  1.  .. S D2=0
  1.  .. F  S D2=+$O(^GMT(142,D0,1,D1,1,D2)) Q:D2=0  D
  1.  ... I $P(^GMT(142,D0,1,D1,1,D2,0),U,1)'=VP Q
  1.  ... S TEXT(1)=""
  1.  ... S TEXT(2)="Changing Health Summary Type "_$P(^GMT(142,D0,0),U,1)_" Selection Item"
  1.  ... S TEXT(3)=" from "_$P(^AUTTHF(HFIEN,0),U,1)
  1.  ... S TEXT(4)=" to "_CNAME
  1.  ... D MSG(.TEXT)
  1.  ... S IENS=D2_","_D1_","_D0_","
  1.  ... S FDA(142.14,IENS,.01)=CNAME
  1.  ... D FILE^DIE("ET","FDA","MSG")
  1.  ... I '$D(MSG) Q
  1.  ... K TEXT
  1.  ... S TEXT(1)=""
  1.  ... S TEXT(2)="There was an error changing the Selection Item"
  1.  ... S TEXT(3)="the FileMan error message is:"
  1.  ... D EN^DDIOL(.TEXT)
  1.  ... D AWRITE^PXRMUTIL("MSG") H 3
  1.  Q
  1.  ;
  1.  ;====================
  1. INSALL ;Install all components in a repository entry.
  1.  N IND,INSTALL
  1.  ;Initialize the name change storage.
  1.  K PXRMNMCH
  1.  S (IND,INSTALL,PXRMDONE)=0
  1.  F  S IND=$O(^TMP("PXRMEXLC",$J,"SEL",IND)) Q:(+IND=0)!(PXRMDONE)  D
  1.  . D INSCOM(IND,.INSTALL)
  1.  ;
  1.  ;If anything was installed rebuild the display.
  1.  I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
  1.  ;
  1.  ;Save the install history in the repository.
  1.  D SAVHIST^PXRMEXU1
  1.  Q
  1.  ;
  1.  ;====================
  1. INSCOM(IND,INSTALL) ;Install component IND.
  1.  ;PXRMRIEN is not passed because this is invoked by the ListManger
  1.  ;action to install a repository entry.
  1.  N ACTION,ATTR,END,EXISTS,FIELDNUM,FILENUM,IND120,JND120
  1.  N NEWNAME,NEWPT01,PT01,RTN,START,TEMP,TEMP0
  1.  S TEMP=^TMP("PXRMEXLC",$J,"SEL",IND)
  1.  S FILENUM=$P(TEMP,U,1)
  1.  S IND120=$P(TEMP,U,2)
  1.  S JND120=$P(TEMP,U,3)
  1.  S EXISTS=$P(TEMP,U,4)
  1.  ;Dialogs use their own installation screen.
  1.  I FILENUM=801.41 D  Q
  1.  . D DBUILD^PXRMEXLB(PXRMRIEN,IND120,JND120)
  1.  . D START^PXRMEXLD
  1.  . S VALMBCK="R"
  1.  S TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
  1.  S START=$P(TEMP,U,2)
  1.  S END=$P(TEMP,U,3)
  1.  S TEMP=^PXD(811.8,PXRMRIEN,100,START,0)
  1.  ;Go to full screen mode.
  1.  D FULL^VALM1
  1.  I ((FILENUM=0)!(FILENUM=811.4)),DUZ(0)'="@" D  Q
  1.  . I FILENUM=0 W !,"Only programmers can install routines."
  1.  . I FILENUM=811.4 W !,"Only programmers can install Reminder Computed Findings."
  1.  . H 2
  1.  . S VALMBCK="R"
  1.  I FILENUM=0 D
  1.  . D RTNLD^PXRMEXIC(PXRMRIEN,START,END,.ATTR,.RTN)
  1.  . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
  1.  . S ACTION=$$GETRACT^PXRMEXCF(.ATTR,.NEWNAME,.PXRMNMCH,.RTN,EXISTS)
  1.  .;Save what was done for the installation summary.
  1.  . S ^TMP("PXRMEXIA",$J,IND,"ROUTINE",ATTR("NAME"),ACTION)=NEWNAME
  1.  E  D
  1.  .;Make sure we have the .01, some files have .001.
  1.  . S TEMP0=$P(TEMP,";",3)
  1.  . S FIELDNUM=$P(TEMP0,"~",1)
  1.  . I FIELDNUM=.001 S TEMP=^PXD(811.8,PXRMRIEN,100,(START+1),0)
  1.  . S PT01=$P(TEMP,"~",2)
  1.  . D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
  1.  . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
  1.  . S ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXISTS)
  1.  .;Save what was done for the installation summary.
  1.  . S ^TMP("PXRMEXIA",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
  1.  ;If the ACTION is Quit then quit the entire install.
  1.  I ACTION="Q" S PXRMDONE=1 Q
  1.  ;If the ACTION is Skip then skip this component.
  1.  I ACTION="S" S VALMBCK="R" Q
  1.  ;If the ACTION is rePlace then skip this component.
  1.  I ACTION="P" S VALMBCK="R" Q
  1.  ;Install this component.
  1.  I FILENUM=0 D
  1.  . S NEWPT01=$G(PXRMNMCH(ATTR("FILE NUMBER"),ATTR("NAME")))
  1.  . I NEWPT01="" S NEWPT01=ATTR("NAME")
  1.  . D RTNSAVE^PXRMEXIC(.RTN,NEWPT01)
  1.  . S INSTALL=1
  1.  E  D
  1.  . D FILE^PXRMEXIC(PXRMRIEN,EXISTS,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
  1.  . S INSTALL=1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;====================
  1. INSSEL ;Get a list of components to install.
  1.  N IND,INSTALL,VALMBG,VALMLST,VALMY
  1.  ;
  1.  S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLC",$J,"IDX",""),-1)
  1.  ;
  1.  ;Get the list to install.
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) Q
  1.  ;
  1.  K ^TMP("PXRMEXIA",$J),^TMP("PXRMEXIAD",$J)
  1.  ;
  1.  ;Initialize the name change storage.
  1.  K PXRMNMCH
  1.  S (IND,INSTALL)=0
  1.  F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D INSCOM(IND,.INSTALL)
  1.  ;
  1.  ;If anything was installed rebuild the display.
  1.  I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
  1.  ;
  1.  ;Save the install history in the repository.
  1.  D SAVHIST^PXRMEXU1
  1.  Q
  1.  ;
  1.  ;====================
  1. INSTALL ;Install the repository entry PXRMRIEN.
  1.  N CLOK,IEN,IND,VALMY
  1.  ;Make sure the component list exists for this entry. PXRMRIEN is
  1.  ;set in INSTALL^PXRMEXLR.
  1.  S CLOK=1
  1.  I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXCO(PXRMRIEN,.CLOK)
  1.  I 'CLOK Q
  1.  ;Look for packing attributes and build the list if it does not exist.
  1.  I '$D(^PXD(811.8,PXRMRIEN,140)) D PATTR^PXRMEXU1(PXRMRIEN)
  1.  K ^TMP($J,"HFCAT")
  1.  ;Format the component list for display.
  1.  D CDISP^PXRMEXLC(PXRMRIEN)
  1.  S VALMCNT=$O(^TMP("PXRMEXLC",$J,"IDX"),-1)
  1.  S VALMBCK="R"
  1.  D XQORM
  1.  Q
  1.  ;
  1.  ;====================
  1. MSG(TEXT) ;Display messages.
  1.  D FULL^VALM1
  1.  D EN^DDIOL(.TEXT)
  1.  H 3
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;====================
  1.  ;Exit action added to PXRM EXCH INSTALL MENU
  1. PEXIT ;PXRM EXCH INSTALL MENU protocol exit code
  1.  S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
  1.  ;Reset after page up/down etc
  1.  D XQORM
  1.  Q
  1.  ;
  1.  ;====================
  1. XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT COMPONENT",0))_U_"1:"_VALMCNT
  1.  S XQORM("A")="Select Action: "
  1.  Q
  1.  ;
  1.  ;====================
  1. XSEL ;PXRM EXCH SELECT COMPONENT validation
  1.  N CNT,SELECT,SEL,PXRMDONE
  1.  S SELECT=$P(XQORNOD(0),"=",2)
  1.  I '$$VALID^PXRMEXLD(SELECT) S VALMBCK="R" Q
  1.  ;
  1.  ;Sort selections into ascending sequence order
  1.  D ORDER^PXRMEXLC(.SELECT,1)
  1.  ;
  1.  K ^TMP("PXRMEXIA",$J),^TMP("PXRMEXIAD",$J)
  1.  ;
  1.  ;Install selected component
  1.  N INSTALL
  1.  S INSTALL=0,CNT=0,PXRMDONE=0
  1.  F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL  D  Q:PXRMDONE
  1.  . D INSCOM(SEL,.INSTALL)
  1.  ;
  1.  ;If anything was installed rebuild the display.
  1.  I INSTALL D CDISP^PXRMEXLC(PXRMRIEN)
  1.  ;
  1.  ;Save the install history in the repository.
  1.  D SAVHIST^PXRMEXU1
  1.  ;
  1.  ;Clear any renames made in the last session
  1.  K PXRMNMCH
  1.  Q
  1.  ;