PXRMEXLM ;SLC/PKR/PJH - Clinical Reminder Exchange List Manager routines. ;12/20/2013
;;2.0;CLINICAL REMINDERS;**6,12,17,24,26**;Feb 04, 2005;Build 404
;
;=====================================================
CRE ;Create a packed reminder and store it in the repository.
D FULL^VALM1
D CRE^PXRMEXPD
S VALMBCK="R"
Q
;
;=====================================================
DEFINQ ;Reminder definition inquiry.
N GBL,IEN,PXRMROOT,VALMCNT
S GBL="^TMP(""PXRMRINQ"",$J)"
S GBL=$NA(@GBL)
S PXRMROOT="^PXD(811.9,"
S IEN=$$SELECT^PXRMINQ(PXRMROOT,"Select Reminder Definition: ","")
S IEN=$P(IEN,U,1)
I IEN=-1 S VALMBCK="R" Q
K ^TMP("PXRMRINQ",$J)
D REMVAR^PXRMINQ(GBL,IEN)
S VALMCNT=$O(^TMP("PXRMRINQ",$J,""),-1)
D EN^VALM("PXRM EX DEFINITION INQUIRY")
K ^TMP("PXRMRINQ",$J)
S VALMBCK="R"
Q
;
;=====================================================
ENTRY ;Entry code
D INITMPG^PXRMEXLM
D BLDLIST^PXRMEXLC(0)
D XQORM
Q
;
;=====================================================
EXIT ;Exit code
D INITMPG^PXRMEXLM
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
K PXRMIGDS,PXRMINST
Q
;
;=====================================================
HDR ; Header code
S VALMHDR(1)="Exchange File Entries."
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
;=====================================================
HELP ;Help code
;The following variables have to be newed so that when we return
;from the help display they will be defined.
N ORU,ORUPRMT,XQORM
D EN^VALM("PXRM EX MAIN HELP")
Q
;
;=====================================================
INIT ;Init
S VALMCNT=0
Q
;
;=====================================================
INITMPG ;Initialized all the ^TMP globals.
K ^TMP("PXRMEXDH",$J)
K ^TMP("PXRMEXDGH",$J)
K ^TMP("PXRMEXDL",$J)
K ^TMP("PXRMEXHF",$J)
K ^TMP("PXRMEXFND",$J)
K ^TMP("PXRMEXIA",$J)
K ^TMP("PXRMEXIAD",$J)
K ^TMP("PXRMEXID",$J)
K ^TMP("PXRMEXIH",$J)
K ^TMP("PXRMEXLC",$J)
K ^TMP("PXRMEXLD",$J)
K ^TMP("PXRMEXLHF",$J)
K ^TMP("PXRMEXLMM",$J)
K ^TMP("PXRMEXLR",$J)
K ^TMP("PXRMEXMH",$J)
K ^TMP("PXRMEXMM",$J)
K ^TMP("PXRMEXRI",$J)
K ^TMP("PXRMEXTMP",$J)
K ^TMP("PXRMEXTXT",$J)
K ^TMP($J,"HS TYPE")
K ^TMP($J,"HS OBJECT")
K ^TMP($J,"TIU OBJECT")
K ^TMP($J,"ORDER DIALOG")
Q
;
;=====================================================
LDHF ;Load a host file into the repository.
N IND,FILE,PATH,RBL,SUCCESS,TEMP
;Select the host file to load.
D CLEAR^VALM1
S TEMP=$$GETEHF^PXRMEXHF("PRD")
I TEMP="" S VALMBCK="R" Q
S PATH=$P(TEMP,U,1)
S FILE=$P(TEMP,U,2)
D LHF^PXRMEXHF(.SUCCESS,PATH,FILE)
S RBL=SUCCESS
I SUCCESS D
. S VALMHDR(1)="Host file "_PATH_FILE_" successfully loaded."
E D
. S VALMHDR(1)="There were problems loading host file "_PATH_FILE_"."
. S TEMP=""
. S IND=""
. F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
.. I SUCCESS(IND) S RBL=1 Q
.. I +$O(SUCCESS(IND))=0 S TEMP=TEMP_IND
.. E S TEMP=TEMP_IND_", "
. S VALMHDR(2)="Entries with problems were "_TEMP_"."
;Rebuild the list for display.
D BLDLIST^PXRMEXLC(RBL)
S VALMBCK="R"
Q
;
;=====================================================
LDMM ;Load a MailMan message into the repository.
N IND,RBL,TEMP,XMZ
;Select the MailMan message to load.
D CLEAR^VALM1
S XMZ=$$GETMESSN^PXRMEXMM
I XMZ=-1 W !,"No packed reminder definitions selected/found!" H 2
I +XMZ'>0 S VALMBCK="R" Q
D LMM^PXRMEXMM(.SUCCESS,XMZ)
S RBL=SUCCESS
I SUCCESS D
. S VALMHDR(1)="MailMan message "_XMZ_" successfully loaded."
.;Rebuild the list for display.
. D BLDLIST^PXRMEXLC(1)
E D
. S VALMHDR(1)="There were problems loading MailMan message "_XMZ_"."
. S TEMP=""
. S IND=""
. F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
.. I SUCCESS(IND) S RBL=1 Q
.. I +$O(SUCCESS(IND))=0 S TEMP=TEMP_IND
.. E S TEMP=TEMP_IND_", "
. S VALMHDR(2)="Entries with problems were "_TEMP_"."
;Rebuild the list for display.
D BLDLIST^PXRMEXLC(RBL)
S VALMBCK="R"
Q
;
;=====================================================
LDWEB ;Load a host file from a web site into the repository.
N SUCCESS,TEMP,URL
S SUCCESS=$$LWEB^PXRMEXWB(.URL)
I SUCCESS D
. S VALMHDR(1)=URL_" successfully loaded."
E D
. S VALMHDR(1)="There were problems loading "_URL
. I URL="" S VALMHDR(1)="No URL specified."
;Rebuild the list for display.
D BLDLIST^PXRMEXLC(SUCCESS)
S VALMBCK="R"
Q
;
;=====================================================
LRDEF ;List the name and print name of all reminder definitions.
N VALMCNT
I $D(^TMP("PXRMEXLD",$J,"VALMCNT")) S VALMCNT=^TMP("PXRMEXLD",$J,"VALMCNT")
E D
. N ARO,DEFLIST
. S ARO=$$QUERYAO^PXRMLIST
. S ^TMP("PXRMEXLD",$J,"ARO")=ARO
. D RDEF^PXRMLIST(.DEFLIST,ARO)
. M ^TMP("PXRMEXLD",$J)=DEFLIST
. S VALMCNT=DEFLIST("VALMCNT")
I '$G(^TMP("PXRMEXLD",$J,"ARO")) D CHGCAP^VALM("INACTIVE","Inactive")
D EN^VALM("PXRM EX REMINDER LIST")
Q
;
;=====================================================
PEXIT ;PXRM EXCH MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up/down etc
D XQORM
Q
;
;=====================================================
START ;Main entry point for PXRM EXCHANGE
N PXRMDONE,PXRMNMCH
;PXRMDONE is set to true if the user enters an action of Quit.
S PXRMDONE=0
;PXRMNMCH is used to store name change information. If a finding
;is copied to a new name or is replaced by another finding the
;information is stored here. It is used when installing definitions
;or dialogs so they use the new or replaced finding.
N VALMBCK,VALMSG,X,XMZ
S X="IORESET"
D ENDR^%ZISS
D EN^VALM("PXRM EX REMINDER EXCHANGE")
W IORESET
D KILL^%ZISS
Q
;
;=====================================================
XQORM ;Set the range for selection.
N NEXCHE
S NEXCHE=^TMP("PXRMEXLR",$J,"NEXCHE")
S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT ENTRY",0))_U_"1:"_NEXCHE
S XQORM("A")="Select Action: "
Q
;
;=====================================================
XSEL ;PXRM EXCH SELECT COMPONENT validation
N SEL,PXRMRIEN
S SEL=$P(XQORNOD(0),"=",2)
;Remove trailing ,
I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
;Invalid selection
I SEL["," D Q
.W $C(7),!,"Only one item number allowed." H 2
.S VALMBCK="R"
I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
.W $C(7),!,SEL_" is not a valid item number." H 2
.S VALMBCK="R"
;
;Get the repository ien.
S PXRMRIEN=^TMP("PXRMEXLR",$J,"SEL",SEL)
;
;Full screen mode
D FULL^VALM1
;
;Option to Install, Delete or Install History
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
S DIR(0)="SBM"_U_"IFE:Install Exchange File Entry;"
S DIR(0)=DIR(0)_"DFE:Delete Exchange File Entry;"
S DIR(0)=DIR(0)_"IH:Installation History;"
S DIR("A")="Select Action: "
S DIR("B")="IFE"
S DIR("?")="Select from the codes displayed. For detailed help type ??"
S DIR("??")=U_"D HLP^PXRMEXIX(3)"
D ^DIR
I $D(DIROUT)!$D(DIRUT) S VALMBCK="R" Q
I $D(DTOUT)!$D(DUOUT) S VALMBCK="R" Q
S OPTION=Y
;
;Install
I OPTION="IFE" D
.D EN^VALM("PXRM EX LIST COMPONENTS")
.K ^TMP("PXRMEXLC",$J)
;
I OPTION="DFE" D
.N COUNT,DELLIST,IEN,IND,RELIST,VALMY
.S DELLIST(PXRMRIEN)=""
.D DELETE^PXRMEXU1(.DELLIST)
.;Rebuild the list for List Manager to display.
.K ^TMP("PXRMEXLR",$J)
.D REXL^PXRMLIST("PXRMEXLR")
.S VALMCNT=^TMP("PXRMEXLR",$J,"VALMCNT")
.S VALMHDR(1)="Deleted 1 exchange file entry",VALMHDR(2)=" ",VALMBCK="R"
;
I OPTION="IH" D START^PXRMEXIH
;
S VALMBCK="R"
Q
;
PXRMEXLM ;SLC/PKR/PJH - Clinical Reminder Exchange List Manager routines. ;12/20/2013
+1 ;;2.0;CLINICAL REMINDERS;**6,12,17,24,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;=====================================================
CRE ;Create a packed reminder and store it in the repository.
+1 DO FULL^VALM1
+2 DO CRE^PXRMEXPD
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
+6 ;=====================================================
DEFINQ ;Reminder definition inquiry.
+1 NEW GBL,IEN,PXRMROOT,VALMCNT
+2 SET GBL="^TMP(""PXRMRINQ"",$J)"
+3 SET GBL=$NAME(@GBL)
+4 SET PXRMROOT="^PXD(811.9,"
+5 SET IEN=$$SELECT^PXRMINQ(PXRMROOT,"Select Reminder Definition: ","")
+6 SET IEN=$PIECE(IEN,U,1)
+7 IF IEN=-1
SET VALMBCK="R"
QUIT
+8 KILL ^TMP("PXRMRINQ",$JOB)
+9 DO REMVAR^PXRMINQ(GBL,IEN)
+10 SET VALMCNT=$ORDER(^TMP("PXRMRINQ",$JOB,""),-1)
+11 DO EN^VALM("PXRM EX DEFINITION INQUIRY")
+12 KILL ^TMP("PXRMRINQ",$JOB)
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
+16 ;=====================================================
ENTRY ;Entry code
+1 DO INITMPG^PXRMEXLM
+2 DO BLDLIST^PXRMEXLC(0)
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=====================================================
EXIT ;Exit code
+1 DO INITMPG^PXRMEXLM
+2 DO CLEAN^VALM10
+3 DO FULL^VALM1
+4 SET VALMBCK="Q"
+5 KILL PXRMIGDS,PXRMINST
+6 QUIT
+7 ;
+8 ;=====================================================
HDR ; Header code
+1 SET VALMHDR(1)="Exchange File Entries."
+2 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+3 QUIT
+4 ;
+5 ;=====================================================
HELP ;Help code
+1 ;The following variables have to be newed so that when we return
+2 ;from the help display they will be defined.
+3 NEW ORU,ORUPRMT,XQORM
+4 DO EN^VALM("PXRM EX MAIN HELP")
+5 QUIT
+6 ;
+7 ;=====================================================
INIT ;Init
+1 SET VALMCNT=0
+2 QUIT
+3 ;
+4 ;=====================================================
INITMPG ;Initialized all the ^TMP globals.
+1 KILL ^TMP("PXRMEXDH",$JOB)
+2 KILL ^TMP("PXRMEXDGH",$JOB)
+3 KILL ^TMP("PXRMEXDL",$JOB)
+4 KILL ^TMP("PXRMEXHF",$JOB)
+5 KILL ^TMP("PXRMEXFND",$JOB)
+6 KILL ^TMP("PXRMEXIA",$JOB)
+7 KILL ^TMP("PXRMEXIAD",$JOB)
+8 KILL ^TMP("PXRMEXID",$JOB)
+9 KILL ^TMP("PXRMEXIH",$JOB)
+10 KILL ^TMP("PXRMEXLC",$JOB)
+11 KILL ^TMP("PXRMEXLD",$JOB)
+12 KILL ^TMP("PXRMEXLHF",$JOB)
+13 KILL ^TMP("PXRMEXLMM",$JOB)
+14 KILL ^TMP("PXRMEXLR",$JOB)
+15 KILL ^TMP("PXRMEXMH",$JOB)
+16 KILL ^TMP("PXRMEXMM",$JOB)
+17 KILL ^TMP("PXRMEXRI",$JOB)
+18 KILL ^TMP("PXRMEXTMP",$JOB)
+19 KILL ^TMP("PXRMEXTXT",$JOB)
+20 KILL ^TMP($JOB,"HS TYPE")
+21 KILL ^TMP($JOB,"HS OBJECT")
+22 KILL ^TMP($JOB,"TIU OBJECT")
+23 KILL ^TMP($JOB,"ORDER DIALOG")
+24 QUIT
+25 ;
+26 ;=====================================================
LDHF ;Load a host file into the repository.
+1 NEW IND,FILE,PATH,RBL,SUCCESS,TEMP
+2 ;Select the host file to load.
+3 DO CLEAR^VALM1
+4 SET TEMP=$$GETEHF^PXRMEXHF("PRD")
+5 IF TEMP=""
SET VALMBCK="R"
QUIT
+6 SET PATH=$PIECE(TEMP,U,1)
+7 SET FILE=$PIECE(TEMP,U,2)
+8 DO LHF^PXRMEXHF(.SUCCESS,PATH,FILE)
+9 SET RBL=SUCCESS
+10 IF SUCCESS
Begin DoDot:1
+11 SET VALMHDR(1)="Host file "_PATH_FILE_" successfully loaded."
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET VALMHDR(1)="There were problems loading host file "_PATH_FILE_"."
+14 SET TEMP=""
+15 SET IND=""
+16 FOR
SET IND=$ORDER(SUCCESS(IND))
IF +IND=0
QUIT
Begin DoDot:2
+17 IF SUCCESS(IND)
SET RBL=1
QUIT
+18 IF +$ORDER(SUCCESS(IND))=0
SET TEMP=TEMP_IND
+19 IF '$TEST
SET TEMP=TEMP_IND_", "
End DoDot:2
+20 SET VALMHDR(2)="Entries with problems were "_TEMP_"."
End DoDot:1
+21 ;Rebuild the list for display.
+22 DO BLDLIST^PXRMEXLC(RBL)
+23 SET VALMBCK="R"
+24 QUIT
+25 ;
+26 ;=====================================================
LDMM ;Load a MailMan message into the repository.
+1 NEW IND,RBL,TEMP,XMZ
+2 ;Select the MailMan message to load.
+3 DO CLEAR^VALM1
+4 SET XMZ=$$GETMESSN^PXRMEXMM
+5 IF XMZ=-1
WRITE !,"No packed reminder definitions selected/found!"
HANG 2
+6 IF +XMZ'>0
SET VALMBCK="R"
QUIT
+7 DO LMM^PXRMEXMM(.SUCCESS,XMZ)
+8 SET RBL=SUCCESS
+9 IF SUCCESS
Begin DoDot:1
+10 SET VALMHDR(1)="MailMan message "_XMZ_" successfully loaded."
+11 ;Rebuild the list for display.
+12 DO BLDLIST^PXRMEXLC(1)
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET VALMHDR(1)="There were problems loading MailMan message "_XMZ_"."
+15 SET TEMP=""
+16 SET IND=""
+17 FOR
SET IND=$ORDER(SUCCESS(IND))
IF +IND=0
QUIT
Begin DoDot:2
+18 IF SUCCESS(IND)
SET RBL=1
QUIT
+19 IF +$ORDER(SUCCESS(IND))=0
SET TEMP=TEMP_IND
+20 IF '$TEST
SET TEMP=TEMP_IND_", "
End DoDot:2
+21 SET VALMHDR(2)="Entries with problems were "_TEMP_"."
End DoDot:1
+22 ;Rebuild the list for display.
+23 DO BLDLIST^PXRMEXLC(RBL)
+24 SET VALMBCK="R"
+25 QUIT
+26 ;
+27 ;=====================================================
LDWEB ;Load a host file from a web site into the repository.
+1 NEW SUCCESS,TEMP,URL
+2 SET SUCCESS=$$LWEB^PXRMEXWB(.URL)
+3 IF SUCCESS
Begin DoDot:1
+4 SET VALMHDR(1)=URL_" successfully loaded."
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET VALMHDR(1)="There were problems loading "_URL
+7 IF URL=""
SET VALMHDR(1)="No URL specified."
End DoDot:1
+8 ;Rebuild the list for display.
+9 DO BLDLIST^PXRMEXLC(SUCCESS)
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
+13 ;=====================================================
LRDEF ;List the name and print name of all reminder definitions.
+1 NEW VALMCNT
+2 IF $DATA(^TMP("PXRMEXLD",$JOB,"VALMCNT"))
SET VALMCNT=^TMP("PXRMEXLD",$JOB,"VALMCNT")
+3 IF '$TEST
Begin DoDot:1
+4 NEW ARO,DEFLIST
+5 SET ARO=$$QUERYAO^PXRMLIST
+6 SET ^TMP("PXRMEXLD",$JOB,"ARO")=ARO
+7 DO RDEF^PXRMLIST(.DEFLIST,ARO)
+8 MERGE ^TMP("PXRMEXLD",$JOB)=DEFLIST
+9 SET VALMCNT=DEFLIST("VALMCNT")
End DoDot:1
+10 IF '$GET(^TMP("PXRMEXLD",$JOB,"ARO"))
DO CHGCAP^VALM("INACTIVE","Inactive")
+11 DO EN^VALM("PXRM EX REMINDER LIST")
+12 QUIT
+13 ;
+14 ;=====================================================
PEXIT ;PXRM EXCH MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up/down etc
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;=====================================================
START ;Main entry point for PXRM EXCHANGE
+1 NEW PXRMDONE,PXRMNMCH
+2 ;PXRMDONE is set to true if the user enters an action of Quit.
+3 SET PXRMDONE=0
+4 ;PXRMNMCH is used to store name change information. If a finding
+5 ;is copied to a new name or is replaced by another finding the
+6 ;information is stored here. It is used when installing definitions
+7 ;or dialogs so they use the new or replaced finding.
+8 NEW VALMBCK,VALMSG,X,XMZ
+9 SET X="IORESET"
+10 DO ENDR^%ZISS
+11 DO EN^VALM("PXRM EX REMINDER EXCHANGE")
+12 WRITE IORESET
+13 DO KILL^%ZISS
+14 QUIT
+15 ;
+16 ;=====================================================
XQORM ;Set the range for selection.
+1 NEW NEXCHE
+2 SET NEXCHE=^TMP("PXRMEXLR",$JOB,"NEXCHE")
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM EXCH SELECT ENTRY",0))_U_"1:"_NEXCHE
+4 SET XQORM("A")="Select Action: "
+5 QUIT
+6 ;
+7 ;=====================================================
XSEL ;PXRM EXCH SELECT COMPONENT validation
+1 NEW SEL,PXRMRIEN
+2 SET SEL=$PIECE(XQORNOD(0),"=",2)
+3 ;Remove trailing ,
+4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
+5 ;Invalid selection
+6 IF SEL[","
Begin DoDot:1
+7 WRITE $CHAR(7),!,"Only one item number allowed."
HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("SEL",SEL)))
Begin DoDot:1
+10 WRITE $CHAR(7),!,SEL_" is not a valid item number."
HANG 2
+11 SET VALMBCK="R"
End DoDot:1
QUIT
+12 ;
+13 ;Get the repository ien.
+14 SET PXRMRIEN=^TMP("PXRMEXLR",$JOB,"SEL",SEL)
+15 ;
+16 ;Full screen mode
+17 DO FULL^VALM1
+18 ;
+19 ;Option to Install, Delete or Install History
+20 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,OPTION,X,Y
+21 SET DIR(0)="SBM"_U_"IFE:Install Exchange File Entry;"
+22 SET DIR(0)=DIR(0)_"DFE:Delete Exchange File Entry;"
+23 SET DIR(0)=DIR(0)_"IH:Installation History;"
+24 SET DIR("A")="Select Action: "
+25 SET DIR("B")="IFE"
+26 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
+27 SET DIR("??")=U_"D HLP^PXRMEXIX(3)"
+28 DO ^DIR
+29 IF $DATA(DIROUT)!$DATA(DIRUT)
SET VALMBCK="R"
QUIT
+30 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMBCK="R"
QUIT
+31 SET OPTION=Y
+32 ;
+33 ;Install
+34 IF OPTION="IFE"
Begin DoDot:1
+35 DO EN^VALM("PXRM EX LIST COMPONENTS")
+36 KILL ^TMP("PXRMEXLC",$JOB)
End DoDot:1
+37 ;
+38 IF OPTION="DFE"
Begin DoDot:1
+39 NEW COUNT,DELLIST,IEN,IND,RELIST,VALMY
+40 SET DELLIST(PXRMRIEN)=""
+41 DO DELETE^PXRMEXU1(.DELLIST)
+42 ;Rebuild the list for List Manager to display.
+43 KILL ^TMP("PXRMEXLR",$JOB)
+44 DO REXL^PXRMLIST("PXRMEXLR")
+45 SET VALMCNT=^TMP("PXRMEXLR",$JOB,"VALMCNT")
+46 SET VALMHDR(1)="Deleted 1 exchange file entry"
SET VALMHDR(2)=" "
SET VALMBCK="R"
End DoDot:1
+47 ;
+48 IF OPTION="IH"
DO START^PXRMEXIH
+49 ;
+50 SET VALMBCK="R"
+51 QUIT
+52 ;
