PXRMEXLI ; SLC/PKR - List Manager routines for repository entry install. ;03/30/2009
;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
;
;================================================
EXIT ;Cleanup ^TMP arrays.
K ^TMP("PXRMEXLC",$J),^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J)
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
;Format the component list for display.
D CDISP^PXRMEXLC(PXRMRIEN)
S VALMCNT=$O(^TMP("PXRMEXLC",$J,"IDX"),-1)
S VALMBCK="R"
D XQORM
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
;
PXRMEXLI ; SLC/PKR - List Manager routines for repository entry install. ;03/30/2009
+1 ;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
+2 ;
+3 ;================================================
EXIT ;Cleanup ^TMP arrays.
+1 KILL ^TMP("PXRMEXLC",$JOB),^TMP("PXRMEXTMP",$JOB),^TMP("PXRMEXFND",$JOB)
+2 QUIT
+3 ;
+4 ;================================================
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 ;Format the component list for display.
+8 DO CDISP^PXRMEXLC(PXRMRIEN)
+9 SET VALMCNT=$ORDER(^TMP("PXRMEXLC",$JOB,"IDX"),-1)
+10 SET VALMBCK="R"
+11 DO XQORM
+12 QUIT
+13 ;
+14 ;================================================
+15 ;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 ;
