Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (15 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLR.m

    r613 r623  
    1 PXRMEXLR        ; SLC/PKR/PJH - List Manager routines for existing repository entries. ;07/30/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;==================================================
    4 CHF     ;Create a host file containing repository entries.
    5         N IND,FILE,LENH2,PATH,SUCCESS,TEMP,VALMY
    6         ;Get the list to store.
    7         D EN^VALM2(XQORNOD(0))
    8         ;If there is no list quit.
    9         I '$D(VALMY) Q
    10         ;Get the host file to use.
    11         D CLEAR^VALM1
    12         S TEMP=$$GETHFS^PXRMEXHF
    13         I TEMP=0 S VALMBCK="R" Q
    14         S PATH=$P(TEMP,U,1)
    15         S FILE=$P(TEMP,U,2)
    16         D CHF^PXRMEXHF(.SUCCESS,.VALMY,PATH,FILE)
    17         S VALMHDR(1)="Successfully stored entries"
    18         S VALMHDR(2)="Failed to store entries"
    19         S LENH2=$L(VALMHDR(2))
    20         S IND=""
    21         F  S IND=$O(SUCCESS(IND)) Q:+IND=0  D
    22         . I SUCCESS(IND) S VALMHDR(1)=VALMHDR(1)_" "_IND
    23         . E  S VALMHDR(2)=VALMHDR(2)_" "_IND
    24         I $L(VALMHDR(2))=LENH2 K VALMHDR(2)
    25         S VALMBCK="R"
    26         Q
    27         ;
    28         ;==================================================
    29 CMM     ;Create a MailMan message containing packed reminders.
    30         N SUCCESS,TEMP,VALMY
    31         ;Get the list to store.
    32         D EN^VALM2(XQORNOD(0))
    33         ;If there is no list quit.
    34         I '$D(VALMY) Q
    35         ;Get a new message number to store the entries in.
    36         D CMM^PXRMEXMM(.SUCCESS,.VALMY)
    37         I $D(SUCCESS("XMZ")) S VALMHDR(1)="Successfully stored entries in message "_SUCCESS("XMZ")_"."
    38         E  S VALMHDR(1)="Failed to store entries"
    39         S VALMBCK="R"
    40         Q
    41         ;
    42         ;==================================================
    43 DELETE  ;Get a list of repository entries and delete them.
    44         N COUNT,DELLIST,IEN,IND,RELIST,VALMY
    45         ;Get the list to delete.
    46         D MIENLIST(.DELLIST)
    47         S COUNT=+$G(DELLIST("COUNT"))
    48         I COUNT=0 Q
    49         D DELETE^PXRMEXU1(.DELLIST)
    50         ;Rebuild the list for List Manager to display.
    51         K ^TMP("PXRMEXLR",$J)
    52         D REXL^PXRMLIST("PXRMEXLR")
    53         ;
    54         S VALMHDR(1)="Deleted "_DELLIST("COUNT")_" Exchange File"
    55         I COUNT>1 S VALMHDR(1)=VALMHDR(1)_" entries."
    56         I COUNT=1 S VALMHDR(1)=VALMHDR(1)_" entry."
    57         I COUNT=0 S VALMHDR(1)="No entries selected."
    58         S VALMHDR(2)=" "
    59         S VALMBCK="R"
    60         Q
    61         ;
    62         ;==================================================
    63 EXIT    ; Exit code
    64         D CLEAN^VALM10
    65         D FULL^VALM1
    66         S VALMBCK="R"
    67         K ^TMP("PXRMEXLR",$J)
    68         Q
    69         ;
    70         ;==================================================
    71 INSTALL ;Get a list of repository entries and install them.
    72         N IND,PXRMRIEN,VALMY
    73         D EN^VALM2(XQORNOD(0))
    74         ;If there is no list quit.
    75         I '$D(VALMY) Q
    76         ;PXRMDONE is newed in PXRMEXLM
    77         S PXRMDONE=0
    78         S IND=""
    79         F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
    80         .;Get the repository ien.
    81         . S PXRMRIEN=^TMP("PXRMEXLR",$J,"SEL",IND)
    82         .;The list template calls INSTALL^PXRMEXLI
    83         . D EN^VALM("PXRM EX LIST COMPONENTS")
    84         . K ^TMP("PXRMEXLC",$J)
    85         Q
    86         ;
    87         ;==================================================
    88 HDR     ; Header code
    89         S VALMHDR(1)=""
    90         D CHGCAP^VALM("RNAME","Reminder Name")
    91         D CHGCAP^VALM("PNAME","Date Loaded")
    92         Q
    93         ;
    94         ;==================================================
    95 HELP    ; Help code
    96         S X="?" D DISP^XQORM1 W !!
    97         Q
    98         ;
    99         ;==================================================
    100 MIENLIST(LIST)  ;Get a list of List Manager repository entries and turn it
    101         ;into iens.
    102         N COUNT,IEN,VALMY
    103         D EN^VALM2(XQORNOD(0))
    104         ;If there is no list quit.
    105         I '$D(VALMY) Q
    106         S COUNT=0
    107         S IND=""
    108         F  S IND=$O(VALMY(IND)) Q:+IND=0  D
    109         . S COUNT=COUNT+1
    110         . ;S IEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
    111         . S IEN=^TMP("PXRMEXLR",$J,"SEL",IND)
    112         . S LIST(IEN)=""
    113         S LIST("COUNT")=COUNT
    114         Q
    115         ;
    116         ;==================================================
    117 PEXIT   ;PXRM EXCH INSTALLATION MENU protocol exit code
    118         S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
    119         Q
    120         ;
     1PXRMEXLR ; SLC/PKR/PJH - List Manager routines for existing repository entries. ;01/10/2003
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;==================================================
     4CHF ;Create a host file containing repository entries.
     5 N IND,FILE,LENH2,PATH,SUCCESS,TEMP,VALMY
     6 ;Get the list to store.
     7 D EN^VALM2(XQORNOD(0))
     8 ;If there is no list quit.
     9 I '$D(VALMY) Q
     10 ;Get the host file to use.
     11 D CLEAR^VALM1
     12 S TEMP=$$GETHFS^PXRMEXHF
     13 I TEMP=0 S VALMBCK="R" Q
     14 S PATH=$P(TEMP,U,1)
     15 S FILE=$P(TEMP,U,2)
     16 D CHF^PXRMEXHF(.SUCCESS,.VALMY,PATH,FILE)
     17 S VALMHDR(1)="Successfully stored entries"
     18 S VALMHDR(2)="Failed to store entries"
     19 S LENH2=$L(VALMHDR(2))
     20 S IND=""
     21 F  S IND=$O(SUCCESS(IND)) Q:+IND=0  D
     22 . I SUCCESS(IND) S VALMHDR(1)=VALMHDR(1)_" "_IND
     23 . E  S VALMHDR(2)=VALMHDR(2)_" "_IND
     24 I $L(VALMHDR(2))=LENH2 K VALMHDR(2)
     25 S VALMBCK="R"
     26 Q
     27 ;
     28 ;==================================================
     29CMM ;Create a MailMan message containing packed reminders.
     30 N SUCCESS,TEMP,VALMY
     31 ;Get the list to store.
     32 D EN^VALM2(XQORNOD(0))
     33 ;If there is no list quit.
     34 I '$D(VALMY) Q
     35 ;Get a new message number to store the entries in.
     36 D CMM^PXRMEXMM(.SUCCESS,.VALMY)
     37 I $D(SUCCESS("XMZ")) S VALMHDR(1)="Successfully stored entries in message "_SUCCESS("XMZ")_"."
     38 E  S VALMHDR(1)="Failed to store entries"
     39 S VALMBCK="R"
     40 Q
     41 ;
     42 ;==================================================
     43DELETE ;Get a list of repository entries and delete them.
     44 N COUNT,DELLIST,IEN,IND,RELIST,VALMY
     45 ;Get the list to delete.
     46 D MIENLIST(.DELLIST)
     47 S COUNT=+$G(DELLIST("COUNT"))
     48 I COUNT=0 Q
     49 D DELETE^PXRMEXU1(.DELLIST)
     50 ;Rebuild the list for List Manager to display.
     51 K ^TMP("PXRMEXLR",$J)
     52 D RE^PXRMLIST(.RELIST,.IEN)
     53 M ^TMP("PXRMEXLR",$J)=RELIST
     54 S VALMCNT=RELIST("VALMCNT")
     55 F IND=1:1:VALMCNT S ^TMP("PXRMEXLR",$J,"IDX",IND,IND)=IEN(IND)
     56 ;
     57 S VALMHDR(1)="Deleted "_DELLIST("COUNT")_" Exchange File"
     58 I COUNT>1 S VALMHDR(1)=VALMHDR(1)_" entries."
     59 I COUNT=1 S VALMHDR(1)=VALMHDR(1)_" entry."
     60 I COUNT=0 S VALMHDR(1)="No entries selected."
     61 S VALMHDR(2)=" "
     62 S VALMBCK="R"
     63 Q
     64 ;
     65 ;==================================================
     66DELHIST ;Get a list of repository installation entries and delete them.
     67 ;Save the original list, it contains the selected repository entries.
     68 N VALMYO
     69 M VALMYO=VALMY
     70 N IHIND,IND,RIEN,TEMP,VALMY
     71 N VALMBG,VALMLST
     72 ;
     73 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
     74 ;Get the list to delete.
     75 D EN^VALM2(XQORNOD(0))
     76 ;If there is no list quit.
     77 I '$D(VALMY) Q
     78 S IND=""
     79 F  S IND=$O(VALMY(IND)) Q:IND=""  D
     80 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
     81 . S RIEN=$P(TEMP,U,1)
     82 . S IHIND=$P(TEMP,U,2)
     83 . D DELHIST^PXRMEXU1(RIEN,IHIND)
     84 ;Rebuild the display list.
     85 D HISTLIST^PXRMEXLC(.VALMYO,.VALMCNT)
     86 S VALMBCK="R"
     87 Q
     88 ;
     89 ;==================================================
     90EXIT ; Exit code
     91 D CLEAN^VALM10
     92 D FULL^VALM1
     93 S VALMBCK="R"
     94 K ^TMP("PXRMEXLR",$J)
     95 Q
     96 ;
     97 ;==================================================
     98IH ;Get a list of repository entries and show their installation history.
     99 N VALMCNT,VALMY
     100 D EN^VALM2(XQORNOD(0))
     101 ;If there is no list quit.
     102 I '$D(VALMY) Q
     103 ;Build a history list.
     104 D HISTLIST^PXRMEXLC(.VALMY,.VALMCNT)
     105 D EN^VALM("PXRM EX INSTALLATION HISTORY")
     106 K ^TMP("PXRMEXIH",$J)
     107 S VALMBCK="R"
     108 Q
     109 ;
     110 ;==================================================
     111INDETAIL ;Output the details of an installation.
     112 N VALMBG,VALMCNT,VALMHDR,VALMLST,VALMY
     113 S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXIH",$J,"IDX",""),-1)
     114 ;Get the list to display.
     115 D EN^VALM2(XQORNOD(0))
     116 ;If there is no list quit.
     117 I '$D(VALMY) Q
     118 D INDISP(.VALMY)
     119 Q
     120 ;
     121 ;==================================================
     122INDISP(ARRAY) ;Display details list
     123 N ACTION,CMPNT,DI,DP,ENTRY,IHIND,IND,INDEX,JND,KND
     124 N NAME,NEWNAME,NLINE,RIEN,TEMP
     125 K ^TMP("PXRMEXID",$J)
     126 ;If there are no items then quit.
     127 I '$D(ARRAY) Q
     128 S (IND,NLINE)=0
     129 F  S IND=$O(ARRAY(IND)) Q:IND=""  D
     130 . S TEMP=^TMP("PXRMEXIH",$J,"SEL",IND)
     131 . S RIEN=$P(TEMP,U,1)
     132 . S IHIND=$P(TEMP,U,2)
     133 . S TEMP=^PXD(811.8,RIEN,0)
     134 . S ENTRY=$E($P(TEMP,U,1),1,38)
     135 . S ENTRY=$$LJ^XLFSTR(ENTRY,38," ")
     136 . S DP=$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
     137 . S DI=$$FMTE^XLFDT(^PXD(811.8,RIEN,130,IHIND,0),"5Z")
     138 . I NLINE>1 D
     139 .. S NLINE=NLINE+1
     140 .. S ^TMP("PXRMEXID",$J,NLINE,0)="------------------------------------------------------------------------------"
     141 . S NLINE=NLINE+1
     142 . S ^TMP("PXRMEXID",$J,NLINE,0)=ENTRY_" "_DP_"  "_DI
     143 .;Write the header line here.
     144 . S NLINE=NLINE+1
     145 . S ^TMP("PXRMEXID",$J,NLINE,0)="     Component                         Action  New Name"
     146 . S CMPNT=""
     147 . S JND=0
     148 . F  S JND=$O(^PXD(811.8,RIEN,130,IHIND,1,JND)) Q:JND=""  D
     149 .. S TEMP=^PXD(811.8,RIEN,130,IHIND,1,JND,0)
     150 .. I $P(TEMP,U,2)'=CMPNT D
     151 ... S NLINE=NLINE+1
     152 ... S ^TMP("PXRMEXID",$J,NLINE,0)=" "
     153 ... S CMPNT=$P(TEMP,U,2)
     154 ... S NLINE=NLINE+1
     155 ... S ^TMP("PXRMEXID",$J,NLINE,0)=CMPNT
     156 .. S INDEX=$$RJ^XLFSTR($P(TEMP,U,1),4," ")
     157 .. S NAME=$E($P(TEMP,U,3),1,36)
     158 .. S NAME=$$LJ^XLFSTR(NAME,36," ")
     159 .. S ACTION=$P(TEMP,U,4)
     160 .. S NEWNAME=$E($P(TEMP,U,5),1,36)
     161 .. S NEWNAME=$$LJ^XLFSTR(NEWNAME,36," ")
     162 .. S NLINE=NLINE+1
     163 .. S ^TMP("PXRMEXID",$J,NLINE,0)=INDEX_" "_NAME_" "_ACTION_"    "_NEWNAME
     164 ..;If there are Additional Details add them to the display.
     165 .. S KND=0
     166 .. F  S KND=$O(^PXD(811.8,RIEN,130,IHIND,1,JND,1,KND)) Q:KND=""  D
     167 ... S NLINE=NLINE+1
     168 ... S ^TMP("PXRMEXID",$J,NLINE,0)=^PXD(811.8,RIEN,130,IHIND,1,JND,1,KND,0)
     169 . S NLINE=NLINE+1
     170 . S ^TMP("PXRMEXID",$J,NLINE,0)=" "
     171 S VALMHDR(1)=^PXD(811.8,RIEN,0)_"  "_^TMP("PXRMEXID",$J,1,0)
     172 S VALMCNT=NLINE
     173 D EN^VALM("PXRM EX INSTALLATION DETAIL")
     174 K ^TMP("PXRMEXID",$J)
     175 S VALMBCK="R"
     176 Q
     177 ;
     178 ;==================================================
     179INSTALL ;Get a list of repository entries and install them.
     180 N IND,PXRMRIEN,VALMY
     181 D EN^VALM2(XQORNOD(0))
     182 ;If there is no list quit.
     183 I '$D(VALMY) Q
     184 ;PXRMDONE is newed in PXRMEXLM
     185 S PXRMDONE=0
     186 S IND=""
     187 F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
     188 .;Get the repository ien.
     189 . S PXRMRIEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
     190 .;The list template calls INSTALL^PXRMEXLI
     191 . D EN^VALM("PXRM EX LIST COMPONENTS")
     192 . K ^TMP("PXRMEXLC",$J)
     193 Q
     194 ;
     195 ;==================================================
     196HDR ; Header code
     197 S VALMHDR(1)=""
     198 D CHGCAP^VALM("RNAME","Reminder Name")
     199 D CHGCAP^VALM("PNAME","Date Loaded")
     200 Q
     201 ;
     202 ;==================================================
     203HELP ; Help code
     204 S X="?" D DISP^XQORM1 W !!
     205 Q
     206 ;
     207 ;==================================================
     208IS ;Get a list of packed reminders and print the installation summary.
     209 N VALMY
     210 D EN^VALM2(XQORNOD(0))
     211 ;If there is no list quit.
     212 I '$D(VALMY) Q
     213 Q
     214 ;
     215 ;==================================================
     216MIENLIST(LIST) ;Get a list of List Manager repository entries and turn it
     217 ;into iens.
     218 N COUNT,IEN,VALMY
     219 D EN^VALM2(XQORNOD(0))
     220 ;If there is no list quit.
     221 I '$D(VALMY) Q
     222 S COUNT=0
     223 S IND=""
     224 F  S IND=$O(VALMY(IND)) Q:+IND=0  D
     225 . S COUNT=COUNT+1
     226 . S IEN=^TMP("PXRMEXLR",$J,"IDX",IND,IND)
     227 . S LIST(IEN)=""
     228 S LIST("COUNT")=COUNT
     229 Q
     230 ;
     231 ;==================================================
     232PEXIT ;PXRM EXCH INSTALLATION MENU protocol exit code
     233 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
     234 ;Reset after page up/down etc
     235 D XQORM
     236 Q
     237 ;
     238 ;==================================================
     239XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT HISTORY",0))_U_"1:"_VALMCNT
     240 S XQORM("A")="Select Action: "
     241 Q
     242 ;
     243 ;==================================================
     244XSEL ;PXRM EXCH SELECT HISTORY validation
     245 N ARRAY,CNT,SELECT,SEL
     246 S SELECT=$P(XQORNOD(0),"=",2)
     247 I '$$VALID^PXRMEXLD(SELECT) S VALMBCK="R" Q
     248 ;Build array of selected items
     249 F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL  D
     250 .S ARRAY(SEL)=""
     251 ;
     252 ;Display Selected Histories
     253 D INDISP(.ARRAY)
     254 Q
Note: See TracChangeset for help on using the changeset viewer.