Routine: PXRMEXHF

PXRMEXHF ;SLC/PKR - Routines to select and deal with host files. ;07/08/2020

 ;;2.0;CLINICAL REMINDERS;**12,17,18,26,74**;Feb 04, 2005;Build 5

 ;================

CHF(SUCCESS,LIST,PATH,FILE) ;Put the repository entries in LIST into the

 ;host file specified by PATH and FILE.

 N IND,GBL,LEN,LNUM,RIEN

 S SUCCESS=1

 S LNUM=$P(LIST,",",1)

 I LNUM="" Q

 S RIEN=$$RIEN^PXRMEXU1(LNUM)

 S GBL="^PXD(811.8,"_RIEN_",100,1,0)"

 ;Save the first entry.

 S SUCCESS(LNUM)=$$GTF^%ZISH(GBL,4,PATH,FILE)

 I SUCCESS(LNUM)=0 Q

 S LEN=$L(LIST,",")-1

 I LEN=1 Q

 ;Append any remaining entries.

 F IND=2:1:LEN D

 . S LNUM=$P(LIST,",",IND)

 . S RIEN=$$RIEN^PXRMEXU1(LNUM)

 . S GBL="^PXD(811.8,"_RIEN_",100,1,0)"

 . S SUCCESS(LNUM)=$$GATF^%ZISH(GBL,4,PATH,FILE)

 ;================

GETEHF(EXT,DPATH) ;Get an existing host file.

 ;Build a list of all .EXT files in the current directory.

 N DEXT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILESPEC,FILELIST,PATH,X,Y

 I EXT="" D

 . S DIR(0)="FAU"_U_"1:32"

 . S DIR("A")="Enter a file extension: "

 . S DIR("?")="A file specification has the format name.extension."

 . D ^DIR

 . S EXT=Y

 I $D(DIRUT) Q ""

 S DEXT="*."_EXT

 S FILESPEC(DEXT)=""

 S PATH=$S($G(DPATH)'="":DPATH,1:$$PWD^%ZISH)

 S DIR(0)="FAU"_U_"1:32"

 S DIR("A")="Enter a path: "

 S DIR("B")=PATH

 S DIR("?",1)="A host file is a file on your host system."

 S DIR("?",2)="A complete host file consists of a path, file name, and extension."

 S DIR("?",3)="A path consists of a device and directory name."

 I $G(EXT)'="" S DIR("?",4)="The default extension is "_EXT_"."

 S DIR("?")="The default path is "_PATH

 D ^DIR

 I $D(DIRUT) Q ""

 S PATH=Y

 S Y=$$LIST^%ZISH(PATH,"FILESPEC","FILELIST")

 I Y D

 . W !,"The following "_EXT_" files were found in ",PATH

 . S FILE=""

 . F  S FILE=$O(FILELIST(FILE)) Q:FILE=""  W !,?2,FILE

 E  W !,"No "_EXT_" files were found in path ",PATH

 K DIR,X,Y

 S DIR(0)="FAOU"_U_"1:32"

 S DIR("A")="Enter a file name: "

 S DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_EXT

 S DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"

 S DIR("?")="  "_PATH_"FILE."_EXT

 D ^DIR

 I $D(DIRUT) Q ""

 S FILE=Y

 ;Add the default extension if there isn't one.

 I FILE'["." S FILE=FILE_"."_EXT

 Q PATH_U_FILE

 ;================

GETHFN(EXT) ;Get the name of a host file to store repository entries in.

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILE,HFNAME,PATH,X,Y

GETHF ;As a default set the path to the current directory.

 S PATH=$$PWD^%ZISH

 S DIR(0)="FAU"_U_"1:32"

 S DIR("A")="Enter a path: "

 S DIR("B")=PATH

 S DIR("?",1)="A host file is a file on your host system."

 S DIR("?",2)="A complete host file consists of a path, file name, and extension."

 S DIR("?",3)="A path consists of a device and directory name."

 I $G(EXT)'="" S DIR("?",4)="The default extension is "_EXT_"."

 S DIR("?")="The default path is "_PATH

 D ^DIR

 I $D(DIRUT) Q 0

 S PATH=Y

 K DIR,X,Y

 S DIR(0)="FAU"_U_"1:32"

 S DIR("A")="Enter a file name: "

 I $G(EXT)'="" D

 . S DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_EXT

 . S DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"

 . S DIR("?")="  "_PATH_"FILE."_EXT

 E  D

 . S DIR("?",1)="A file name has the format NAME.EXTENSION"

 . S DIR("?")="There is no default extension so you must input the complete file name."

 D ^DIR

 I $D(DIRUT) Q 0

 S FILE=Y

 ;Add the default extension if there isn't one.

 I FILE'["." S FILE=FILE_"."_EXT

 I $P(FILE,".",2)="" W !,"The file name must include an extension." G GETHF

 S HFNAME=PATH_FILE

 S DIR(0)="YAO"

 S DIR("A")="Host file is "_HFNAME_" is this correct?: "

 S DIR("B")="Y"

 K X,Y

 D ^DIR

 I $D(DIRUT) Q 0

 I 'Y G GETHF

 Q PATH_U_FILE

 ;================

LHF(SUCCESS,PATH,FILE) ;Load a host file containing exchange entries into

 ;the Exchange file.

 N GBL

 K ^TMP($J,"EXHF")

 S GBL="^TMP($J,""EXHF"",1,1)"

 S GBL=$NA(@GBL)

 S SUCCESS=$$FTG^%ZISH(PATH,FILE,GBL,3)

 I 'SUCCESS Q

 ;Make sure it has the correct format.

 I (^TMP($J,"EXHF",1,1)'["xml")!(^TMP($J,"EXHF",2,1)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D  Q

 . W !,"This host file does not have the correct format!"

 . H 2

 . S SUCCESS=0

 . K ^TMP($J,"EXHF")

 W !,"Loading host file ",PATH,FILE

 D LTMP(.SUCCESS,"EXHF")

 ;================

LTMP(SUCCESS,NODE) ;Load the contents of ^TMP($J,NODE) into the Exchange

 ;file. The format is ^TMP($J,NODE,NUM,1)=data

 N CURRL,CSUM,DATEP,DONE,EXIEN,EXTYPE,FDA,IENROOT,IND,LINE

 N MSG,NENTRY,NLINES,RETMP,RNAME,SITE,SOURCE,SSOURCE,US,USER,VRSN

 S RETMP="^TMP($J,""EXLHF"")"

 S (CURRL,DONE,NENTRY,NLINES,SSOURCE)=0

 F  Q:DONE  D

 . S CURRL=CURRL+1

 . I '$D(^TMP($J,NODE,CURRL,1)) S DONE=1 Q

 . S LINE=^TMP($J,NODE,CURRL,1)

 .;Look for overflow lines.

 . S IND=0

 . F  S IND=$O(^TMP($J,NODE,CURRL,"OVF",IND)) Q:IND=""  S LINE=LINE_^TMP($J,NODE,CURRL,"OVF",IND)

 . S NLINES=NLINES+1

 . S ^TMP($J,"EXLHF",NLINES,0)=LINE

 . I LINE["<PACKAGE_VERSION>" S VRSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")

 . I LINE["<EXCHANGE_TYPE>" S EXTYPE=$$GETTAGV^PXRMEXU3(LINE,"<EXCHANGE_TYPE>",1)

 . I LINE="<SOURCE>" S SSOURCE=1

 . I SSOURCE D

 .. I LINE["<NAME>" S RNAME=$$GETTAGV^PXRMEXU3(LINE,"<NAME>",1)

 .. I LINE["<USER>" S USER=$$GETTAGV^PXRMEXU3(LINE,"<USER>",1)

 .. I LINE["<SITE>" S SITE=$$GETTAGV^PXRMEXU3(LINE,"<SITE>",1)

 .. I LINE["<DATE_PACKED>" S DATEP=$$GETTAGV^PXRMEXU3(LINE,"<DATE_PACKED>")

 . I LINE="</SOURCE>" D

 .. S SSOURCE=0

 .. S SOURCE=USER_" at "_SITE

 .;See if the entry is loaded into the temporary storage.

 . I LINE="</REMINDER_EXCHANGE_FILE_ENTRY>" D

 .. S NLINES=0

 .. S NENTRY=NENTRY+1

 ..;Make sure it has the correct format.

 .. I (^TMP($J,"EXLHF",1,0)'["xml")!(^TMP($J,"EXLHF",2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D  Q

 ... W !,"There is a problem reading this .prd file, try a new copy of it."

 ... S SUCCESS=0

 ... H 2

 ..;Make sure this entry does not already exist.

 .. S EXIEN=$$REXISTS^PXRMEXIU(RNAME,DATEP)

 .. I EXIEN>0 D

 ... W !,RNAME

 ... W !,"with a date packed of ",DATEP

 ... W !,"is already in the Exchange File, it will not be added again."

 ... S SUCCESS(NENTRY)=EXIEN_"A"

 ... H 2

 .. E  D

 ... K FDA,IENROOT

 ... S FDA(811.8,"+1,",.01)=RNAME

 ... S FDA(811.8,"+1,",.02)=SOURCE

 ... S FDA(811.8,"+1,",.03)=DATEP

 ... D UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)

 ... S SUCCESS(NENTRY)=US

 ...;Create the description and save the data.

 ... N DESCT,DESL,KEYWORDT

 ... D DESC^PXRMEXU3(RETMP,.DESCT)

 ... D KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)

 ... S DESL("RNAME")=RNAME,DESL("SOURCE")=SOURCE,DESL("DATEP")=DATEP

 ... S DESL("VRSN")=VRSN

 ... D DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")

 ... M ^PXD(811.8,IENROOT(1),100)=^TMP($J,"EXLHF")

 ... W !,"Added Reminder Exchange entry ",RNAME H 2

 .. K ^TMP($J,"EXLHF")

 ;Check the success of the entry installs.

 K ^TMP($J,NODE),^TMP($J,"EXLHF")

 ;If no entries were created there was a problem.

 I NENTRY=0 S SUCCESS=0 Q

 S SUCCESS=1

 S IND=""

 F  S IND=$O(SUCCESS(IND)) Q:+IND=0  D

 . I 'SUCCESS(IND) S SUCCESS=0 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXHF   7203     printed  Mar 13, 2025@20:49:36                                                                                                                                                                                                    Page 2

PXRMEXHF  ;SLC/PKR - Routines to select and deal with host files. ;07/08/2020

 +1       ;;2.0;CLINICAL REMINDERS;**12,17,18,26,74**;Feb 04, 2005;Build 5

 +2       ;================

CHF(SUCCESS,LIST,PATH,FILE) ;Put the repository entries in LIST into the

 +1       ;host file specified by PATH and FILE.

 +2        NEW IND,GBL,LEN,LNUM,RIEN

 +3        SET SUCCESS=1

 +4        SET LNUM=$PIECE(LIST,",",1)

 +5        IF LNUM=""

               QUIT

 +6        SET RIEN=$$RIEN^PXRMEXU1(LNUM)

 +7        SET GBL="^PXD(811.8,"_RIEN_",100,1,0)"

 +8       ;Save the first entry.

 +9        SET SUCCESS(LNUM)=$$GTF^%ZISH(GBL,4,PATH,FILE)

 +10       IF SUCCESS(LNUM)=0

               QUIT

 +11       SET LEN=$LENGTH(LIST,",")-1

 +12       IF LEN=1

               QUIT

 +13      ;Append any remaining entries.

 +14       FOR IND=2:1:LEN

               Begin DoDot:1

 +15               SET LNUM=$PIECE(LIST,",",IND)

 +16               SET RIEN=$$RIEN^PXRMEXU1(LNUM)

 +17               SET GBL="^PXD(811.8,"_RIEN_",100,1,0)"

 +18               SET SUCCESS(LNUM)=$$GATF^%ZISH(GBL,4,PATH,FILE)

               End DoDot:1

 +19       QUIT

 +20      ;

 +21      ;================

GETEHF(EXT,DPATH) ;Get an existing host file.

 +1       ;Build a list of all .EXT files in the current directory.

 +2        NEW DEXT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILESPEC,FILELIST,PATH,X,Y

 +3        IF EXT=""

               Begin DoDot:1

 +4                SET DIR(0)="FAU"_U_"1:32"

 +5                SET DIR("A")="Enter a file extension: "

 +6                SET DIR("?")="A file specification has the format name.extension."

 +7                DO ^DIR

 +8                SET EXT=Y

               End DoDot:1

 +9        IF $DATA(DIRUT)

               QUIT ""

 +10       SET DEXT="*."_EXT

 +11       SET FILESPEC(DEXT)=""

 +12       SET PATH=$SELECT($GET(DPATH)'="":DPATH,1:$$PWD^%ZISH)

 +13       SET DIR(0)="FAU"_U_"1:32"

 +14       SET DIR("A")="Enter a path: "

 +15       SET DIR("B")=PATH

 +16       SET DIR("?",1)="A host file is a file on your host system."

 +17       SET DIR("?",2)="A complete host file consists of a path, file name, and extension."

 +18       SET DIR("?",3)="A path consists of a device and directory name."

 +19       IF $GET(EXT)'=""

               SET DIR("?",4)="The default extension is "_EXT_"."

 +20       SET DIR("?")="The default path is "_PATH

 +21       DO ^DIR

 +22       IF $DATA(DIRUT)

               QUIT ""

 +23       SET PATH=Y

 +24       SET Y=$$LIST^%ZISH(PATH,"FILESPEC","FILELIST")

 +25       IF Y

               Begin DoDot:1

 +26               WRITE !,"The following "_EXT_" files were found in ",PATH

 +27               SET FILE=""

 +28               FOR

                       SET FILE=$ORDER(FILELIST(FILE))

                       if FILE=""

                           QUIT

                       WRITE !,?2,FILE

               End DoDot:1

 +29      IF '$TEST

               WRITE !,"No "_EXT_" files were found in path ",PATH

 +30      ;

 +31       KILL DIR,X,Y

 +32       SET DIR(0)="FAOU"_U_"1:32"

 +33       SET DIR("A")="Enter a file name: "

 +34       SET DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_EXT

 +35       SET DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"

 +36       SET DIR("?")="  "_PATH_"FILE."_EXT

 +37       DO ^DIR

 +38       IF $DATA(DIRUT)

               QUIT ""

 +39       SET FILE=Y

 +40      ;Add the default extension if there isn't one.

 +41       IF FILE'["."

               SET FILE=FILE_"."_EXT

 +42       QUIT PATH_U_FILE

 +43      ;

 +44      ;================

GETHFN(EXT) ;Get the name of a host file to store repository entries in.

 +1        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILE,HFNAME,PATH,X,Y

GETHF     ;As a default set the path to the current directory.

 +1        SET PATH=$$PWD^%ZISH

 +2        SET DIR(0)="FAU"_U_"1:32"

 +3        SET DIR("A")="Enter a path: "

 +4        SET DIR("B")=PATH

 +5        SET DIR("?",1)="A host file is a file on your host system."

 +6        SET DIR("?",2)="A complete host file consists of a path, file name, and extension."

 +7        SET DIR("?",3)="A path consists of a device and directory name."

 +8        IF $GET(EXT)'=""

               SET DIR("?",4)="The default extension is "_EXT_"."

 +9        SET DIR("?")="The default path is "_PATH

 +10       DO ^DIR

 +11       IF $DATA(DIRUT)

               QUIT 0

 +12       SET PATH=Y

 +13       KILL DIR,X,Y

 +14       SET DIR(0)="FAU"_U_"1:32"

 +15       SET DIR("A")="Enter a file name: "

 +16       IF $GET(EXT)'=""

               Begin DoDot:1

 +17               SET DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_EXT

 +18               SET DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"

 +19               SET DIR("?")="  "_PATH_"FILE."_EXT

               End DoDot:1

 +20      IF '$TEST

               Begin DoDot:1

 +21               SET DIR("?",1)="A file name has the format NAME.EXTENSION"

 +22               SET DIR("?")="There is no default extension so you must input the complete file name."

               End DoDot:1

 +23       DO ^DIR

 +24       IF $DATA(DIRUT)

               QUIT 0

 +25       SET FILE=Y

 +26      ;Add the default extension if there isn't one.

 +27       IF FILE'["."

               SET FILE=FILE_"."_EXT

 +28       IF $PIECE(FILE,".",2)=""

               WRITE !,"The file name must include an extension."

               GOTO GETHF

 +29       SET HFNAME=PATH_FILE

 +30       SET DIR(0)="YAO"

 +31       SET DIR("A")="Host file is "_HFNAME_" is this correct?: "

 +32       SET DIR("B")="Y"

 +33       KILL X,Y

 +34       DO ^DIR

 +35       IF $DATA(DIRUT)

               QUIT 0

 +36       IF 'Y

               GOTO GETHF

 +37       QUIT PATH_U_FILE

 +38      ;

 +39      ;================

LHF(SUCCESS,PATH,FILE) ;Load a host file containing exchange entries into

 +1       ;the Exchange file.

 +2        NEW GBL

 +3        KILL ^TMP($JOB,"EXHF")

 +4        SET GBL="^TMP($J,""EXHF"",1,1)"

 +5        SET GBL=$NAME(@GBL)

 +6        SET SUCCESS=$$FTG^%ZISH(PATH,FILE,GBL,3)

 +7        IF 'SUCCESS

               QUIT

 +8       ;Make sure it has the correct format.

 +9        IF (^TMP($JOB,"EXHF",1,1)'["xml")!(^TMP($JOB,"EXHF",2,1)'="<REMINDER_EXCHANGE_FILE_ENTRY>")

               Begin DoDot:1

 +10               WRITE !,"This host file does not have the correct format!"

 +11               HANG 2

 +12               SET SUCCESS=0

 +13               KILL ^TMP($JOB,"EXHF")

               End DoDot:1

               QUIT

 +14       WRITE !,"Loading host file ",PATH,FILE

 +15       DO LTMP(.SUCCESS,"EXHF")

 +16       QUIT

 +17      ;

 +18      ;================

LTMP(SUCCESS,NODE) ;Load the contents of ^TMP($J,NODE) into the Exchange

 +1       ;file. The format is ^TMP($J,NODE,NUM,1)=data

 +2        NEW CURRL,CSUM,DATEP,DONE,EXIEN,EXTYPE,FDA,IENROOT,IND,LINE

 +3        NEW MSG,NENTRY,NLINES,RETMP,RNAME,SITE,SOURCE,SSOURCE,US,USER,VRSN

 +4        SET RETMP="^TMP($J,""EXLHF"")"

 +5        SET (CURRL,DONE,NENTRY,NLINES,SSOURCE)=0

 +6        FOR

               if DONE

                   QUIT

               Begin DoDot:1

 +7                SET CURRL=CURRL+1

 +8                IF '$DATA(^TMP($JOB,NODE,CURRL,1))

                       SET DONE=1

                       QUIT

 +9                SET LINE=^TMP($JOB,NODE,CURRL,1)

 +10      ;Look for overflow lines.

 +11               SET IND=0

 +12               FOR

                       SET IND=$ORDER(^TMP($JOB,NODE,CURRL,"OVF",IND))

                       if IND=""

                           QUIT

                       SET LINE=LINE_^TMP($JOB,NODE,CURRL,"OVF",IND)

 +13               SET NLINES=NLINES+1

 +14               SET ^TMP($JOB,"EXLHF",NLINES,0)=LINE

 +15               IF LINE["<PACKAGE_VERSION>"

                       SET VRSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")

 +16               IF LINE["<EXCHANGE_TYPE>"

                       SET EXTYPE=$$GETTAGV^PXRMEXU3(LINE,"<EXCHANGE_TYPE>",1)

 +17               IF LINE="<SOURCE>"

                       SET SSOURCE=1

 +18               IF SSOURCE

                       Begin DoDot:2

 +19                       IF LINE["<NAME>"

                               SET RNAME=$$GETTAGV^PXRMEXU3(LINE,"<NAME>",1)

 +20                       IF LINE["<USER>"

                               SET USER=$$GETTAGV^PXRMEXU3(LINE,"<USER>",1)

 +21                       IF LINE["<SITE>"

                               SET SITE=$$GETTAGV^PXRMEXU3(LINE,"<SITE>",1)

 +22                       IF LINE["<DATE_PACKED>"

                               SET DATEP=$$GETTAGV^PXRMEXU3(LINE,"<DATE_PACKED>")

                       End DoDot:2

 +23               IF LINE="</SOURCE>"

                       Begin DoDot:2

 +24                       SET SSOURCE=0

 +25                       SET SOURCE=USER_" at "_SITE

                       End DoDot:2

 +26      ;See if the entry is loaded into the temporary storage.

 +27               IF LINE="</REMINDER_EXCHANGE_FILE_ENTRY>"

                       Begin DoDot:2

 +28                       SET NLINES=0

 +29                       SET NENTRY=NENTRY+1

 +30      ;Make sure it has the correct format.

 +31                       IF (^TMP($JOB,"EXLHF",1,0)'["xml")!(^TMP($JOB,"EXLHF",2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>")

                               Begin DoDot:3

 +32                               WRITE !,"There is a problem reading this .prd file, try a new copy of it."

 +33                               SET SUCCESS=0

 +34                               HANG 2

                               End DoDot:3

                               QUIT

 +35      ;Make sure this entry does not already exist.

 +36                       SET EXIEN=$$REXISTS^PXRMEXIU(RNAME,DATEP)

 +37                       IF EXIEN>0

                               Begin DoDot:3

 +38                               WRITE !,RNAME

 +39                               WRITE !,"with a date packed of ",DATEP

 +40                               WRITE !,"is already in the Exchange File, it will not be added again."

 +41                               SET SUCCESS(NENTRY)=EXIEN_"A"

 +42                               HANG 2

                               End DoDot:3

 +43                      IF '$TEST

                               Begin DoDot:3

 +44                               KILL FDA,IENROOT

 +45                               SET FDA(811.8,"+1,",.01)=RNAME

 +46                               SET FDA(811.8,"+1,",.02)=SOURCE

 +47                               SET FDA(811.8,"+1,",.03)=DATEP

 +48                               DO UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)

 +49                               SET SUCCESS(NENTRY)=US

 +50      ;Create the description and save the data.

 +51                               NEW DESCT,DESL,KEYWORDT

 +52                               DO DESC^PXRMEXU3(RETMP,.DESCT)

 +53                               DO KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)

 +54                               SET DESL("RNAME")=RNAME

                                   SET DESL("SOURCE")=SOURCE

                                   SET DESL("DATEP")=DATEP

 +55                               SET DESL("VRSN")=VRSN

 +56                               DO DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")

 +57                               MERGE ^PXD(811.8,IENROOT(1),100)=^TMP($JOB,"EXLHF")

 +58                               WRITE !,"Added Reminder Exchange entry ",RNAME

                                   HANG 2

                               End DoDot:3

 +59                       KILL ^TMP($JOB,"EXLHF")

                       End DoDot:2

               End DoDot:1

 +60      ;

 +61      ;Check the success of the entry installs.

 +62       KILL ^TMP($JOB,NODE),^TMP($JOB,"EXLHF")

 +63      ;If no entries were created there was a problem.

 +64       IF NENTRY=0

               SET SUCCESS=0

               QUIT

 +65       SET SUCCESS=1

 +66       SET IND=""

 +67       FOR

               SET IND=$ORDER(SUCCESS(IND))

               if +IND=0

                   QUIT

               Begin DoDot:1

 +68               IF 'SUCCESS(IND)

                       SET SUCCESS=0

                       QUIT

               End DoDot:1

 +69       QUIT

 +70      ;

PXRMEXHF.m