Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLM.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLM.m (modified) (1 diff)

WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLM.m

@@ -1 @@
-PXRMEXLM        ; SLC/PKR/PJH - Clinical Reminder Exchange List Manager routines. ;10/11/2007
-        ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-        ;
-        ;=====================================================
-CRE     ;Create a packed reminder and store it in the repository.
-        N RTP,SUCCESS,TMPIND
-        K VALMHDR
-        S RTP=$$GETREM^PXRMEXPU("pack")
-        I +RTP'>0 D  Q
-        . S VALMHDR(1)="No reminder selected!"
-        . S VALMBCK="R"
-        S TMPIND="PXRMEXPR"
-        D PACK^PXRMEXPR(RTP,TMPIND)
-        D STOREPR^PXRMEXU2(.SUCCESS,RTP,TMPIND,"REMINDER")
-        I SUCCESS D
-        . S VALMHDR(1)="Packed reminder for "_$P(RTP,U,2)
-        . S VALMHDR(2)="was saved in Exchange File."
-        . D BLDLIST^PXRMEXLC(1)
-        E  D
-        . S VALMHDR(1)="Creation of packed reminder for "_$P(RTP,U,2)
-        . S VALMHDR(2)="failed; it was not saved!"
-        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 BLDLIST^PXRMEXLC(0)
-        D XQORM
-        Q
-        ;
-        ;=====================================================
-EXIT    ;Exit code
-        K ^TMP("PXRMEXDH",$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)
-        D CLEAN^VALM10
-        D FULL^VALM1
-        S VALMBCK="Q"
-        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
-        ;
-        ;=====================================================
-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
-        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
-        ;
-        ;=====================================================
-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   S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT ENTRY",0))_U_"1:"_VALMCNT
-        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/22/2004
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+ ;
+ ;=====================================================
+CRE ;Create a packed reminder and store it in the repository.
+ N RTP,SUCCESS,TMPIND
+ K VALMHDR
+ S RTP=$$GETREM^PXRMEXPU("pack")
+ I +RTP'>0 D  Q
+ . S VALMHDR(1)="No reminder selected!"
+ . S VALMBCK="R"
+ S TMPIND="PXRMEXPR"
+ D PACK^PXRMEXPR(RTP,TMPIND)
+ D STOREPR^PXRMEXU2(.SUCCESS,RTP,TMPIND,"REMINDER")
+ I SUCCESS D
+ . S VALMHDR(1)="Packed reminder for "_$P(RTP,U,2)
+ . S VALMHDR(2)="was saved in Exchange File."
+ . D BLDLIST^PXRMEXLC(1)
+ E  D
+ . S VALMHDR(1)="Creation of packed reminder for "_$P(RTP,U,2)
+ . S VALMHDR(2)="failed; it was not saved!"
+ 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
+ ;
+ ;=====================================================
+EN ;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 BLDLIST^PXRMEXLC(0)
+ D EN^VALM("PXRM EX REMINDER EXCHANGE")
+ W IORESET
+ D KILL^%ZISS
+ Q
+ ;
+ ;=====================================================
+ENTRY ;Entry code
+ D XQORM
+ Q
+ ;
+ ;=====================================================
+EXIT ;Exit code
+ K ^TMP("PXRMEXDH",$J)
+ K ^TMP("PXRMEXHF",$J)
+ K ^TMP("PXRMEXFND",$J)
+ K ^TMP("PXRMEXIA",$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)
+ D CLEAN^VALM10
+ D FULL^VALM1
+ S VALMBCK="Q"
+ 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
+ ;
+ ;=====================================================
+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
+ 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
+ ;
+ ;=====================================================
+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
+ ;
+XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT ENTRY",0))_U_"1:"_VALMCNT
+ 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@("IDX",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,"IDX",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 RE^PXRMLIST(.RELIST,.IEN)
+ .M ^TMP("PXRMEXLR",$J)=RELIST
+ .S VALMCNT=RELIST("VALMCNT")
+ .F IND=1:1:VALMCNT D
+ ..S ^TMP("PXRMEXLR",$J,"IDX",IND,IND)=IEN(IND)
+ .;
+ .S VALMHDR(1)="Deleted 1 exchange file entry",VALMHDR(2)=" ",VALMBCK="R"
+ ;
+ I OPTION="IH" D
+ .N HISLIST,VALMCNT
+ .S HISLIST(SEL)=""
+ .D HISTLIST^PXRMEXLC(.HISLIST,.VALMCNT)
+ .D EN^VALM("PXRM EX INSTALLATION HISTORY")
+ .K ^TMP("PXRMEXIH",$J)
+ ;
+ S VALMBCK="R"
+ Q