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)
Q
;
;================
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")
Q
;
;================
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXHF 7203 printed Nov 22, 2024@16:55:08 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 ;
