PXRMEXLI.m

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      ;