Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMEXLR

PXRMEXLR.m

Go to the documentation of this file.
  1. 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
  1. ;==================================================
  1. CHF ;Create a host file containing repository entries.
  1. N IND,FILE,LIST,LENH2,NL,PATH,SUCCESS,TEMP
  1. ;Get the list to store.
  1. S LIST=$$GETLIST()
  1. ;If there is no list quit.
  1. I LIST="^" S VALMBCK="R" Q
  1. ;Get the host file to use.
  1. D CLEAR^VALM1
  1. S TEMP=$$GETHFN^PXRMEXHF("PRD")
  1. I TEMP=0 S VALMBCK="R" Q
  1. S PATH=$P(TEMP,U,1)
  1. S FILE=$P(TEMP,U,2)
  1. D CHF^PXRMEXHF(.SUCCESS,LIST,PATH,FILE)
  1. S VALMHDR(1)="Successfully stored entries:"
  1. S VALMHDR(2)="Failed to store entries:"
  1. S LENH2=$L(VALMHDR(2))
  1. S IND="",NL=0
  1. F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
  1. . S NL=NL+1
  1. . S TEMP=$S(NL=1:" ",1:", ")
  1. . I SUCCESS(IND) S VALMHDR(1)=VALMHDR(1)_TEMP_IND
  1. . E S VALMHDR(2)=VALMHDR(2)_TEMP_IND
  1. I $L(VALMHDR(2))=LENH2 K VALMHDR(2)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;==================================================
  1. CMM ;Create a MailMan message containing packed reminders.
  1. N LEN,LIST,SUCCESS,TEMP
  1. ;Get the list to store.
  1. S LIST=$$GETLIST()
  1. ;If there is no list quit.
  1. I LIST="^" S VALMBCK="R" Q
  1. ;Get a new message number to store the entries in.
  1. D CMM^PXRMEXMM(.SUCCESS,LIST)
  1. S LEN=$L(LIST)
  1. S TEMP=$E(LIST,1,(LEN-1))
  1. I $D(SUCCESS("XMZ")) S VALMHDR(1)="Successfully stored entries "_TEMP_" in message "_SUCCESS("XMZ")_"."
  1. E S VALMHDR(1)="Failed to store entries "_TEMP
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;==================================================
  1. DELETE ;Get a list of repository entries and delete them.
  1. N IND,LIST,NUM
  1. ;Get the list to delete.
  1. S LIST=$$GETLIST()
  1. ;If there is no list quit.
  1. I LIST="^" S VALMBCK="R" Q
  1. S NUM=$L(LIST,",")-1
  1. D DELETE^PXRMEXU1(LIST)
  1. ;Rebuild the list for List Manager to display.
  1. K ^TMP("PXRMEXLR",$J)
  1. D REXL^PXRMLIST("PXRMEXLR")
  1. ;
  1. S VALMHDR(1)="Deleted "_NUM_" Exchange File"
  1. I NUM>1 S VALMHDR(1)=VALMHDR(1)_" entries."
  1. I NUM=1 S VALMHDR(1)=VALMHDR(1)_" entry."
  1. S VALMHDR(2)=" "
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;==================================================
  1. EXIT ; Exit code
  1. D CLEAN^VALM10
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. K ^TMP("PXRMEXLR",$J)
  1. Q
  1. ;
  1. ;==================================================
  1. GETLIST() ;Get a list of entries.
  1. N DIR,NEXCHE,X,Y
  1. S NEXCHE=+$G(^TMP("PXRMEXLR",$J,"NEXCHE"))
  1. I NEXCHE=0 Q 0
  1. S DIR(0)="L^1:NEXCHE"
  1. S DIR(0)="L^1:"_NEXCHE
  1. D ^DIR
  1. Q Y
  1. ;
  1. ;==================================================
  1. INSTALL ;Get a list of repository entries and install them.
  1. N IND,LIST,LNUM,PXRMNAT,PXRMRIEN
  1. ;Get the list to install.
  1. S LIST=$$GETLIST()
  1. ;If there is no list quit.
  1. I LIST="^" S VALMBCK="R" Q
  1. ;PXRMDONE is newed in PXRMEXLM
  1. S PXRMDONE=0
  1. F IND=1:1:$L(LIST,",")-1 Q:PXRMDONE D
  1. . S LNUM=$P(LIST,",",IND)
  1. .;Get the repository IEN.
  1. . S PXRMRIEN=$$RIEN^PXRMEXU1(LNUM)
  1. .;Get the Exchange entry's class.
  1. . S PXRMNAT=$$EXCLASS^PXRMEXU2(PXRMRIEN)
  1. .;The list template calls INSTALL^PXRMEXLI
  1. . D EN^VALM("PXRM EX LIST COMPONENTS")
  1. . K ^TMP("PXRMEXLC",$J)
  1. Q
  1. ;
  1. ;==================================================
  1. HDR ; Header code
  1. S VALMHDR(1)=""
  1. D CHGCAP^VALM("RNAME","Reminder Name")
  1. D CHGCAP^VALM("PNAME","Date Loaded")
  1. Q
  1. ;
  1. ;==================================================
  1. HELP ; Help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. ;==================================================
  1. PEXIT ;PXRM EXCH INSTALLATION MENU protocol exit code
  1. S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
  1. Q
  1. ;