PXRMEXLR ; SLC/PKR/PJH - List Manager routines for Exchange file actions. ;08/16/2018
;;2.0;CLINICAL REMINDERS;**6,17,26,42**;Feb 04, 2005;Build 245
;==================================================
CHF ;Create a host file containing repository entries.
N IND,FILE,LIST,LENH2,NL,PATH,SUCCESS,TEMP
;Get the list to store.
S LIST=$$GETLIST()
;If there is no list quit.
I LIST="^" S VALMBCK="R" Q
;Get the host file to use.
D CLEAR^VALM1
S TEMP=$$GETHFN^PXRMEXHF("PRD")
I TEMP=0 S VALMBCK="R" Q
S PATH=$P(TEMP,U,1)
S FILE=$P(TEMP,U,2)
D CHF^PXRMEXHF(.SUCCESS,LIST,PATH,FILE)
S VALMHDR(1)="Successfully stored entries:"
S VALMHDR(2)="Failed to store entries:"
S LENH2=$L(VALMHDR(2))
S IND="",NL=0
F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
. S NL=NL+1
. S TEMP=$S(NL=1:" ",1:", ")
. I SUCCESS(IND) S VALMHDR(1)=VALMHDR(1)_TEMP_IND
. E S VALMHDR(2)=VALMHDR(2)_TEMP_IND
I $L(VALMHDR(2))=LENH2 K VALMHDR(2)
S VALMBCK="R"
Q
;
;==================================================
CMM ;Create a MailMan message containing packed reminders.
N LEN,LIST,SUCCESS,TEMP
;Get the list to store.
S LIST=$$GETLIST()
;If there is no list quit.
I LIST="^" S VALMBCK="R" Q
;Get a new message number to store the entries in.
D CMM^PXRMEXMM(.SUCCESS,LIST)
S LEN=$L(LIST)
S TEMP=$E(LIST,1,(LEN-1))
I $D(SUCCESS("XMZ")) S VALMHDR(1)="Successfully stored entries "_TEMP_" in message "_SUCCESS("XMZ")_"."
E S VALMHDR(1)="Failed to store entries "_TEMP
S VALMBCK="R"
Q
;
;==================================================
DELETE ;Get a list of repository entries and delete them.
N IND,LIST,NUM
;Get the list to delete.
S LIST=$$GETLIST()
;If there is no list quit.
I LIST="^" S VALMBCK="R" Q
S NUM=$L(LIST,",")-1
D DELETE^PXRMEXU1(LIST)
;Rebuild the list for List Manager to display.
K ^TMP("PXRMEXLR",$J)
D REXL^PXRMLIST("PXRMEXLR")
;
S VALMHDR(1)="Deleted "_NUM_" Exchange File"
I NUM>1 S VALMHDR(1)=VALMHDR(1)_" entries."
I NUM=1 S VALMHDR(1)=VALMHDR(1)_" entry."
S VALMHDR(2)=" "
S VALMBCK="R"
Q
;
;==================================================
EXIT ; Exit code
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="R"
K ^TMP("PXRMEXLR",$J)
Q
;
;==================================================
GETLIST() ;Get a list of entries.
N DIR,NEXCHE,X,Y
S NEXCHE=+$G(^TMP("PXRMEXLR",$J,"NEXCHE"))
I NEXCHE=0 Q 0
S DIR(0)="L^1:NEXCHE"
S DIR(0)="L^1:"_NEXCHE
D ^DIR
Q Y
;
;==================================================
INSTALL ;Get a list of repository entries and install them.
N IND,LIST,LNUM,PXRMNAT,PXRMRIEN
;Get the list to install.
S LIST=$$GETLIST()
;If there is no list quit.
I LIST="^" S VALMBCK="R" Q
;PXRMDONE is newed in PXRMEXLM
S PXRMDONE=0
F IND=1:1:$L(LIST,",")-1 Q:PXRMDONE D
. S LNUM=$P(LIST,",",IND)
.;Get the repository IEN.
. S PXRMRIEN=$$RIEN^PXRMEXU1(LNUM)
.;Get the Exchange entry's class.
. S PXRMNAT=$$EXCLASS^PXRMEXU2(PXRMRIEN)
.;The list template calls INSTALL^PXRMEXLI
. D EN^VALM("PXRM EX LIST COMPONENTS")
. K ^TMP("PXRMEXLC",$J)
Q
;
;==================================================
HDR ; Header code
S VALMHDR(1)=""
D CHGCAP^VALM("RNAME","Reminder Name")
D CHGCAP^VALM("PNAME","Date Loaded")
Q
;
;==================================================
HELP ; Help code
S X="?" D DISP^XQORM1 W !!
Q
;
;==================================================
PEXIT ;PXRM EXCH INSTALLATION MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXLR 3593 printed Dec 13, 2024@01:45:07 Page 2
PXRMEXLR ; SLC/PKR/PJH - List Manager routines for Exchange file actions. ;08/16/2018
+1 ;;2.0;CLINICAL REMINDERS;**6,17,26,42**;Feb 04, 2005;Build 245
+2 ;==================================================
CHF ;Create a host file containing repository entries.
+1 NEW IND,FILE,LIST,LENH2,NL,PATH,SUCCESS,TEMP
+2 ;Get the list to store.
+3 SET LIST=$$GETLIST()
+4 ;If there is no list quit.
+5 IF LIST="^"
SET VALMBCK="R"
QUIT
+6 ;Get the host file to use.
+7 DO CLEAR^VALM1
+8 SET TEMP=$$GETHFN^PXRMEXHF("PRD")
+9 IF TEMP=0
SET VALMBCK="R"
QUIT
+10 SET PATH=$PIECE(TEMP,U,1)
+11 SET FILE=$PIECE(TEMP,U,2)
+12 DO CHF^PXRMEXHF(.SUCCESS,LIST,PATH,FILE)
+13 SET VALMHDR(1)="Successfully stored entries:"
+14 SET VALMHDR(2)="Failed to store entries:"
+15 SET LENH2=$LENGTH(VALMHDR(2))
+16 SET IND=""
SET NL=0
+17 FOR
SET IND=$ORDER(SUCCESS(IND))
if +IND=0
QUIT
Begin DoDot:1
+18 SET NL=NL+1
+19 SET TEMP=$SELECT(NL=1:" ",1:", ")
+20 IF SUCCESS(IND)
SET VALMHDR(1)=VALMHDR(1)_TEMP_IND
+21 IF '$TEST
SET VALMHDR(2)=VALMHDR(2)_TEMP_IND
End DoDot:1
+22 IF $LENGTH(VALMHDR(2))=LENH2
KILL VALMHDR(2)
+23 SET VALMBCK="R"
+24 QUIT
+25 ;
+26 ;==================================================
CMM ;Create a MailMan message containing packed reminders.
+1 NEW LEN,LIST,SUCCESS,TEMP
+2 ;Get the list to store.
+3 SET LIST=$$GETLIST()
+4 ;If there is no list quit.
+5 IF LIST="^"
SET VALMBCK="R"
QUIT
+6 ;Get a new message number to store the entries in.
+7 DO CMM^PXRMEXMM(.SUCCESS,LIST)
+8 SET LEN=$LENGTH(LIST)
+9 SET TEMP=$EXTRACT(LIST,1,(LEN-1))
+10 IF $DATA(SUCCESS("XMZ"))
SET VALMHDR(1)="Successfully stored entries "_TEMP_" in message "_SUCCESS("XMZ")_"."
+11 IF '$TEST
SET VALMHDR(1)="Failed to store entries "_TEMP
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
+15 ;==================================================
DELETE ;Get a list of repository entries and delete them.
+1 NEW IND,LIST,NUM
+2 ;Get the list to delete.
+3 SET LIST=$$GETLIST()
+4 ;If there is no list quit.
+5 IF LIST="^"
SET VALMBCK="R"
QUIT
+6 SET NUM=$LENGTH(LIST,",")-1
+7 DO DELETE^PXRMEXU1(LIST)
+8 ;Rebuild the list for List Manager to display.
+9 KILL ^TMP("PXRMEXLR",$JOB)
+10 DO REXL^PXRMLIST("PXRMEXLR")
+11 ;
+12 SET VALMHDR(1)="Deleted "_NUM_" Exchange File"
+13 IF NUM>1
SET VALMHDR(1)=VALMHDR(1)_" entries."
+14 IF NUM=1
SET VALMHDR(1)=VALMHDR(1)_" entry."
+15 SET VALMHDR(2)=" "
+16 SET VALMBCK="R"
+17 QUIT
+18 ;
+19 ;==================================================
EXIT ; Exit code
+1 DO CLEAN^VALM10
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 KILL ^TMP("PXRMEXLR",$JOB)
+5 QUIT
+6 ;
+7 ;==================================================
GETLIST() ;Get a list of entries.
+1 NEW DIR,NEXCHE,X,Y
+2 SET NEXCHE=+$GET(^TMP("PXRMEXLR",$JOB,"NEXCHE"))
+3 IF NEXCHE=0
QUIT 0
+4 SET DIR(0)="L^1:NEXCHE"
+5 SET DIR(0)="L^1:"_NEXCHE
+6 DO ^DIR
+7 QUIT Y
+8 ;
+9 ;==================================================
INSTALL ;Get a list of repository entries and install them.
+1 NEW IND,LIST,LNUM,PXRMNAT,PXRMRIEN
+2 ;Get the list to install.
+3 SET LIST=$$GETLIST()
+4 ;If there is no list quit.
+5 IF LIST="^"
SET VALMBCK="R"
QUIT
+6 ;PXRMDONE is newed in PXRMEXLM
+7 SET PXRMDONE=0
+8 FOR IND=1:1:$LENGTH(LIST,",")-1
if PXRMDONE
QUIT
Begin DoDot:1
+9 SET LNUM=$PIECE(LIST,",",IND)
+10 ;Get the repository IEN.
+11 SET PXRMRIEN=$$RIEN^PXRMEXU1(LNUM)
+12 ;Get the Exchange entry's class.
+13 SET PXRMNAT=$$EXCLASS^PXRMEXU2(PXRMRIEN)
+14 ;The list template calls INSTALL^PXRMEXLI
+15 DO EN^VALM("PXRM EX LIST COMPONENTS")
+16 KILL ^TMP("PXRMEXLC",$JOB)
End DoDot:1
+17 QUIT
+18 ;
+19 ;==================================================
HDR ; Header code
+1 SET VALMHDR(1)=""
+2 DO CHGCAP^VALM("RNAME","Reminder Name")
+3 DO CHGCAP^VALM("PNAME","Date Loaded")
+4 QUIT
+5 ;
+6 ;==================================================
HELP ; Help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;==================================================
PEXIT ;PXRM EXCH INSTALLATION MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 QUIT
+3 ;
