- 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 Jan 18, 2025@02:46:21 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 ;