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