Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 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/PXRMLPP.m

    r613 r623  
    1 PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ;Main entry point for PXRM PATIENT LIST
    5 START(IEN)      ;
    6         N CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE
    7         N VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
    8         ;Get Patient List record and associated data.
    9         S LDATA=$G(^PXRMXP(810.5,IEN,0))
    10         S LNAME=$P(LDATA,U,1)
    11         S CDATE=$P(LDATA,U,4)
    12         S SOURCE=$P(LDATA,U,5),SNAME=""
    13         ;Check if generated from #810.2
    14         I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)
    15         ;If not check if generated from #810.4
    16         I SNAME="" D
    17         . S SOURCE=$P(LDATA,U,6)
    18         . I SOURCE'="" S SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)
    19         ;If still no source check for created from Reminder Due Report.
    20         I SNAME="" D
    21         . S SOURCE=$P(LDATA,U,9)
    22         . I SOURCE'="" S SNAME="Reminder Due Report"
    23         ;If there still is no source then assume it was generated in the
    24         ;past by a Reminder Due Report.
    25         I SNAME="" S SNAME="Reminder Due Report"
    26         ;Creator
    27         S CREATOR=+$P(LDATA,U,7)
    28         S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
    29         ;Type
    30         S TYPE=$P(LDATA,U,8)
    31         S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
    32         ;Class
    33         S CLASS=$P($G(^PXRMXP(810.5,IEN,100)),U)
    34         S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
    35         S INDP=$P(LDATA,U,11)
    36         S INTP=$P(LDATA,U,12)
    37         ;Default view by name.
    38         S PXRMVIEW="N"
    39         S VALMCNT=0
    40         D EN^VALM("PXRM PATIENT LIST PATIENTS")
    41         Q
    42         ;
    43 BLDLIST(IEN)    ;Build a list of all patients
    44         N IND,INCINST
    45         S INCINST=+$P(^PXRMXP(810.5,IEN,0),U,10)
    46         I 'INCINST D CHGCAP^VALM("HEADER3","")
    47         K ^TMP("PXRMLPP",$J),^TMP("PXRMLPPA",$J),^TMP("PXRMLPPI",$J)
    48         D LIST(.VALMCNT,.IEN,INCINST)
    49         F IND=1:1:VALMCNT D
    50         .S ^TMP("PXRMLPP",$J,"IDX",IND,IND)=^TMP("PXRMLPPI",$J,IND)
    51         K ^TMP("PXRMLPPI",$J)
    52         Q
    53 DEM     ;
    54         D FULL^VALM1
    55         D EN^PXRMPDR(IEN)
    56         S VALMBCK="R"
    57         Q
    58         ;
    59 EDIT    ;Edit selected patient list fields.
    60         N DA,DIE,DR,TEMP
    61         S DA=IEN,DIE="^PXRMXP(810.5,"
    62         S DR=".01;.08"
    63         I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR=DR_";.07"
    64         D ^DIE
    65         S TEMP=^PXRMXP(810.5,IEN,0)
    66         S LNAME=$P(TEMP,U,1),CREATOR=$P(TEMP,U,7),TYPE=$P(TEMP,U,8)
    67         S CREATOR=$P(^VA(200,CREATOR,0),U,1)
    68         D HDR^PXRMLPP
    69         S VALMBCK="R"
    70         Q
    71         ;
    72 EDITOK(IEN)     ;Screen for protocol PXRM PATIENT LIST EDIT, return true if
    73         ;the user is permitted to edit the selected patient list.
    74         I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1
    75         N CREATOR
    76         S CREATOR=$P(^PXRMXP(810.5,IEN,0),U,7)
    77         Q $S(CREATOR=DUZ:1,1:0)
    78         ;
    79 ENTRY   ;Entry code
    80         D BLDLIST(IEN)
    81         D XQORM
    82         Q
    83         ;
    84 EXIT    ;Exit code
    85         K ^TMP("PXRMLPP",$J)
    86         K ^TMP("PXRMLPPH",$J)
    87         D CLEAN^VALM10
    88         D FULL^VALM1
    89         S VALMBCK="R"
    90         Q
    91         ;
    92 FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST)       ;Format  entry number, name, primary
    93         ;station and deceased, test information.
    94         N TEMP,TEXT,TNAME,TSOURCE
    95         S TEXT=$$RJ^XLFSTR(NUMBER,5," ")
    96         S TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")
    97         S TEXT=TEXT_"  "_$$LJ^XLFSTR(DFN,15," ")
    98         S TEMP=""
    99         I DECEASED S TEMP=" (D)"
    100         I TESTP S TEMP=" (T)"
    101         I DECEASED,TESTP S TEMP=" (DP)"
    102         S TEXT=TEXT_TEMP
    103         I INST'="" S TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")
    104         Q TEXT
    105         ;
    106 HDR     ; Header code
    107         N TEXT
    108         S VALMHDR(1)="List Name: "_LNAME
    109         S VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
    110         S VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR
    111         S VALMHDR(3)=" Class: "_CLASS
    112         S VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE
    113         S VALMHDR(4)=" Source: "_SNAME
    114         S VALMHDR(5)=" Number of patients: "_VALMCNT
    115         S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
    116         S TEXT=""
    117         I INDP S TEXT=" (D=deceased)"
    118         I INTP S TEXT=" (T=test)"
    119         I INDP,INTP S TEXT=" (D=deceased, T=test)"
    120         S TEXT="DFN"_TEXT
    121         D CHGCAP^VALM("HEADER2",TEXT)
    122         Q
    123         ;
    124 HLP     ;Help code
    125         N ORU,ORUPRMT,SUB,XQORM
    126         S SUB="PXRMLPPH"
    127         D EN^VALM("PXRM PATIENT LIST HELP")
    128         Q
    129 HSA     ;Print Health Summary for all patients on list
    130         D HSA^PXRMLPHS(IEN)
    131         S VALMBCK="R"
    132         Q
    133         ;
    134 HSI     ;Print Health Summary for selected patients.
    135         ;Full Screen
    136         W IORESET
    137         N IND,DFN,PLNODE,PNAME,VALMY
    138         D EN^VALM2(XQORNOD(0))
    139         ;If there is no list quit.
    140         I '$D(VALMY) Q
    141         S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT
    142         K ^XTMP(PLNODE)
    143         S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
    144         S IND="",PXRMDONE=0
    145         F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
    146         .;Get the patient list ien.
    147         .S DFN=^TMP("PXRMLPP",$J,"IDX",IND,IND)
    148         .;DBIA #10035
    149         .S PNAME=$P(^DPT(DFN,0),U,1)
    150         .I PNAME="" S PNAME=DFN_" does not exist"
    151         .S ^XTMP(PLNODE,PNAME)=DFN
    152         D HSI^PXRMLPHS(PLNODE)
    153         S VALMBCK="R"
    154         Q
    155         ;
    156 INIT    ;Init
    157         S VALMCNT=0
    158         Q
    159         ;
    160 LIST(VALMCNT,IEN,INCINST)       ;Build a list of patients.
    161         N DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP
    162         ;Build the ordered list.
    163         S IND=0,SUB="NAME"
    164         F  S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND  D
    165         .S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""
    166         .S DFN=$P(DATA,U) Q:'DFN
    167         .S DECEASED=$P(DATA,U,4)
    168         .S TESTP=$P(DATA,U,5)
    169         .;#DBIA 10035
    170         .S PNAME=$P($G(^DPT(DFN,0)),U,1)
    171         .I PNAME="" S PNAME=DFN_" does not exist"
    172         .S INSTNUM=$P(DATA,U,2) S:INSTNUM="" INSTNUM="NONE"
    173         .S INST=$P(DATA,U,3)
    174         .;Lists built before PXRM*2*4 will only have the Institution ien.
    175         .I INST="" S INST=$P(DATA,U,2)
    176         .I INST="" S INST="NONE"
    177         .I PXRMVIEW="I" S SUB=INST
    178         .S ^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST
    179         ;Transfer to list manager array
    180         S SUB="",VALMCNT=0
    181         F  S SUB=$O(^TMP("PXRMLPPA",$J,SUB)) Q:SUB=""  D
    182         .S (INST,PNAME)=""
    183         .F  S PNAME=$O(^TMP("PXRMLPPA",$J,SUB,PNAME)) Q:PNAME=""  D
    184         ..S DFN=""
    185         ..F  S DFN=$O(^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)) Q:DFN=""  D
    186         ...S DATA=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)
    187         ...S DECEASED=$P(DATA,U,1)
    188         ...S TESTP=$P(DATA,U,2)
    189         ...I INCINST S INST=$P(DATA,U,3)
    190         ...S VALMCNT=VALMCNT+1
    191         ...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)
    192         ...S ^TMP("PXRMLPPI",$J,VALMCNT)=DFN
    193         K ^TMP("PXRMLPPA",$J)
    194         Q
    195         ;
    196 PEXIT   ;PXRM PATIENT LIST PATIENTS MENU protocol exit code
    197         S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
    198         D XQORM
    199         Q
    200         ;
    201 USER    ;
    202         I $P($G(^PXRMXP(810.5,IEN,0)),U,8)="PUB" D FULL^VALM1 W !,"This option is locked for Public Lists." H 2 Q
    203         D FULL^VALM1
    204         D START^PXRMLPAU(IEN)
    205         S VALMBCK="R"
    206         Q
    207         ;
    208 USR(IEN)        ;Screen for protocol PXRM PATIENT LIST AUTH USER
    209         N TYPE
    210         S TYPE=$P(^PXRMXP(810.5,IEN,0),U,8)
    211         ;Public lists cannot have individual user access.
    212         I TYPE="PUB" Q "N"
    213         Q $$ACCESS^PXRMLPU(IEN)
    214         ;
    215 VIEW    ;Select view
    216         W IORESET
    217         S VALMBCK="R",VALMBG=1
    218         N X,Y,CODE,DIR
    219         K DIROUT,DIRUT,DTOUT,DUOUT
    220         S DIR(0)="S"_U_"I:Sort by Institution and Name;"
    221         S DIR(0)=DIR(0)_"N:Sort by Name;"
    222         S DIR("A")="TYPE OF VIEW"
    223         S DIR("B")=$S(PXRMVIEW="N":"I",1:"N")
    224         S DIR("?")="Select from the codes displayed."
    225         D ^DIR K DIR
    226         I $D(DIROUT) S DTOUT=1
    227         I $D(DTOUT)!($D(DUOUT)) Q
    228         ;Change display type
    229         S PXRMVIEW=Y
    230         ;Rebuild Workfile
    231         D BLDLIST^PXRMLPP(IEN),HDR
    232         Q
    233         ;
    234 XSEL    ;PXRM PATIENT LIST PATIENT SELECT validation
    235         N EPIEN,DFN,SEL
    236         S SEL=$P(XQORNOD(0),"=",2)
    237         ;Remove trailing ,
    238         I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
    239         ;Invalid selection
    240         I SEL["," D  Q
    241         .W $C(7),!,"Only one item number allowed." H 2
    242         .S VALMBCK="R"
    243         I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D  Q
    244         .W $C(7),!,SEL_" is not a valid item number." H 2
    245         .S VALMBCK="R"
    246         ;
    247         ;Get the patient list ien
    248         S DFN=^TMP("PXRMLPP",$J,"IDX",SEL,SEL)
    249         ;Full screen mode
    250         D FULL^VALM1
    251         ;Print individual Health Summary
    252         D HSI^PXRMLPHS(DFN)
    253         S VALMBCK="R"
    254         Q
    255         ;
    256 XQORM   S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT
    257         S XQORM("A")="Select Item: "
    258         Q
    259         ;
     1PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;01/06/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ;Main entry point for PXRM PATIENT LIST
     5START(IEN) ;
     6 N CDATE,CLASS,CREATOR,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE
     7 N VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
     8 ;Get Patient List record and associated data.
     9 S LDATA=$G(^PXRMXP(810.5,IEN,0))
     10 S LNAME=$P(LDATA,U,1)
     11 S CDATE=$P(LDATA,U,4)
     12 S SOURCE=$P(LDATA,U,5),SNAME=""
     13 ;Check if generated from #810.2
     14 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)
     15 ;If not check if generated from #810.4
     16 I SNAME="" D
     17 . S SOURCE=$P(LDATA,U,6)
     18 . I SOURCE'="" S SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)
     19 ;If still no source check for created from Reminder Due Report.
     20 I SNAME="" D
     21 . S SOURCE=$P(LDATA,U,9)
     22 . I SOURCE'="" S SNAME="Reminder Due Report"
     23 ;If there still is no source then assume it was generated in the
     24 ;past by a Reminder Due Report.
     25 I SNAME="" S SNAME="Reminder Due Report"
     26 ;Creator
     27 S CREATOR=+$P(LDATA,U,7)
     28 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
     29 ;Type
     30 S TYPE=$P(LDATA,U,8)
     31 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
     32 ;Class
     33 S CLASS=$P($G(^PXRMXP(810.5,IEN,100)),U)
     34 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
     35 ;Default view by name.
     36 S PXRMVIEW="N"
     37 S VALMCNT=0
     38 D EN^VALM("PXRM PATIENT LIST PATIENTS")
     39 Q
     40 ;
     41BLDLIST(IEN) ;Build a list of all patients
     42 N IND,INCINST
     43 S INCINST=+$P(^PXRMXP(810.5,IEN,0),U,10)
     44 I 'INCINST D CHGCAP^VALM("HEADER3","")
     45 K ^TMP("PXRMLPP",$J),^TMP("PXRMLPPA",$J),^TMP("PXRMLPPI",$J)
     46 D LIST(.VALMCNT,.IEN,INCINST)
     47 F IND=1:1:VALMCNT D
     48 .S ^TMP("PXRMLPP",$J,"IDX",IND,IND)=^TMP("PXRMLPPI",$J,IND)
     49 K ^TMP("PXRMLPPI",$J)
     50 Q
     51DEM ;
     52 D FULL^VALM1
     53 D EN^PXRMPDR(IEN)
     54 S VALMBCK="R"
     55 Q
     56 ;
     57EDIT ;Edit selected patient list fields.
     58 N DA,DIE,DR,TEMP
     59 S DA=IEN,DIE="^PXRMXP(810.5,"
     60 S DR=".01;.08"
     61 I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR=DR_";.07"
     62 D ^DIE
     63 S TEMP=^PXRMXP(810.5,IEN,0)
     64 S LNAME=$P(TEMP,U,1),CREATOR=$P(TEMP,U,7),TYPE=$P(TEMP,U,8)
     65 S CREATOR=$P(^VA(200,CREATOR,0),U,1)
     66 D HDR^PXRMLPP
     67 S VALMBCK="R"
     68 Q
     69 ;
     70EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if
     71 ;the user is permitted to edit the selected patient list.
     72 I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1
     73 N CREATOR
     74 S CREATOR=$P(^PXRMXP(810.5,IEN,0),U,7)
     75 Q $S(CREATOR=DUZ:1,1:0)
     76 ;
     77ENTRY ;Entry code
     78 D BLDLIST(IEN)
     79 D XQORM
     80 Q
     81 ;
     82EXIT ;Exit code
     83 K ^TMP("PXRMLPP",$J)
     84 K ^TMP("PXRMLPPH",$J)
     85 D CLEAN^VALM10
     86 D FULL^VALM1
     87 S VALMBCK="R"
     88 Q
     89 ;
     90FRE(NUMBER,NAME,INST,DFN) ;Format  entry number, name and primary station
     91 N TEMP,TNAME,TSOURCE
     92 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
     93 S TNAME=$E(NAME,1,30)
     94 S TEMP=TEMP_"  "_$$LJ^XLFSTR(TNAME,32," ")
     95 S TEMP=TEMP_"  "_$$LJ^XLFSTR(DFN,15," ")
     96 I INST'="" S TEMP=TEMP_"  "_INST
     97 Q TEMP
     98 ;
     99HDR ; Header code
     100 S VALMHDR(1)="List Name: "_LNAME_" ("_VALMCNT_" patients)"
     101 S VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
     102 S VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR
     103 S VALMHDR(3)=" Class: "_CLASS
     104 S VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE
     105 S VALMHDR(4)=" Source: "_SNAME
     106 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
     107 Q
     108 ;
     109HLP ;Help code
     110 N ORU,ORUPRMT,SUB,XQORM
     111 S SUB="PXRMLPPH"
     112 D EN^VALM("PXRM PATIENT LIST HELP")
     113 Q
     114HSA ;Print Health Summary for all patients on list
     115 D HSA^PXRMLPHS(IEN)
     116 S VALMBCK="R"
     117 Q
     118 ;
     119HSI ;Print Health Summary for selected patients.
     120 ;Full Screen
     121 W IORESET
     122 N IND,DFN,PLNODE,PNAME,VALMY
     123 D EN^VALM2(XQORNOD(0))
     124 ;If there is no list quit.
     125 I '$D(VALMY) Q
     126 S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT
     127 K ^XTMP(PLNODE)
     128 S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
     129 S IND="",PXRMDONE=0
     130 F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
     131 .;Get the patient list ien.
     132 .S DFN=^TMP("PXRMLPP",$J,"IDX",IND,IND)
     133 .;DBIA #10035
     134 .S PNAME=$P(^DPT(DFN,0),U,1)
     135 .S ^XTMP(PLNODE,PNAME)=DFN
     136 D HSI^PXRMLPHS(PLNODE)
     137 S VALMBCK="R"
     138 Q
     139 ;
     140INIT ;Init
     141 S VALMCNT=0
     142 Q
     143 ;
     144LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.
     145 N DATA,DFN,IND,INST,NEXT,PNAME,SUB
     146 ;Build the ordered list.
     147 S IND=0,SUB="NAME"
     148 F  S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND  D
     149 .S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""
     150 .S DFN=$P(DATA,U) Q:'DFN
     151 .;#DBIA 10035
     152 .S PNAME=$P($G(^DPT(DFN,0)),U,1)
     153 .S INSTNUM=$P(DATA,U,2) S:INSTNUM="" INSTNUM="NONE"
     154 .S INST=$P(DATA,U,3)
     155 .;Lists built before PXRM*2*4 will only have the Institution ien.
     156 .I INST="" S INST=$P(DATA,U,2)
     157 .I INST="" S INST="NONE"
     158 .I PXRMVIEW="I" S SUB=INST
     159 .S ^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)=INST
     160 ;Transfer to list manager array
     161 S SUB="",VALMCNT=0
     162 F  S SUB=$O(^TMP("PXRMLPPA",$J,SUB)) Q:SUB=""  D
     163 .S (INST,PNAME)=""
     164 .F  S PNAME=$O(^TMP("PXRMLPPA",$J,SUB,PNAME)) Q:PNAME=""  D
     165 ..S DFN=""
     166 ..F  S DFN=$O(^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)) Q:DFN=""  D
     167 ...I INCINST S INST=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)
     168 ...S VALMCNT=VALMCNT+1
     169 ...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,INST,DFN)
     170 ...S ^TMP("PXRMLPPI",$J,VALMCNT)=DFN
     171 K ^TMP("PXRMLPPA",$J)
     172 Q
     173 ;
     174PEXIT ;PXRM PATIENT LIST PATIENTS MENU protocol exit code
     175 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
     176 D XQORM
     177 Q
     178 ;
     179USER ;
     180 I $P($G(^PXRMXP(810.5,IEN,0)),U,8)="PUB" D FULL^VALM1 W !,"This option is locked for Public Lists." H 2 Q
     181 D FULL^VALM1
     182 D START^PXRMLPAU(IEN)
     183 S VALMBCK="R"
     184 Q
     185 ;
     186USR(IEN) ;Screen for protocol PXRM PATIENT LIST AUTH USER
     187 N TYPE
     188 S TYPE=$P(^PXRMXP(810.5,IEN,0),U,8)
     189 ;Public lists cannot have individual user access.
     190 I TYPE="PUB" Q "N"
     191 Q $$ACCESS^PXRMLPU(IEN)
     192 ;
     193VIEW ;Select view
     194 W IORESET
     195 S VALMBCK="R",VALMBG=1
     196 N X,Y,CODE,DIR
     197 K DIROUT,DIRUT,DTOUT,DUOUT
     198 S DIR(0)="S"_U_"I:Sort by Institution and Name;"
     199 S DIR(0)=DIR(0)_"N:Sort by Name;"
     200 S DIR("A")="TYPE OF VIEW"
     201 S DIR("B")=$S(PXRMVIEW="N":"I",1:"N")
     202 S DIR("?")="Select from the codes displayed."
     203 D ^DIR K DIR
     204 I $D(DIROUT) S DTOUT=1
     205 I $D(DTOUT)!($D(DUOUT)) Q
     206 ;Change display type
     207 S PXRMVIEW=Y
     208 ;Rebuild Workfile
     209 D BLDLIST^PXRMLPP(IEN),HDR
     210 Q
     211 ;
     212XSEL ;PXRM PATIENT LIST PATIENT SELECT validation
     213 N EPIEN,DFN,SEL
     214 S SEL=$P(XQORNOD(0),"=",2)
     215 ;Remove trailing ,
     216 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
     217 ;Invalid selection
     218 I SEL["," D  Q
     219 .W $C(7),!,"Only one item number allowed." H 2
     220 .S VALMBCK="R"
     221 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D  Q
     222 .W $C(7),!,SEL_" is not a valid item number." H 2
     223 .S VALMBCK="R"
     224 ;
     225 ;Get the patient list ien
     226 S DFN=^TMP("PXRMLPP",$J,"IDX",SEL,SEL)
     227 ;Full screen mode
     228 D FULL^VALM1
     229 ;Print individual Health Summary
     230 D HSI^PXRMLPHS(DFN)
     231 S VALMBCK="R"
     232 Q
     233 ;
     234XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT
     235 S XQORM("A")="Select Item: "
     236 Q
     237 ;
Note: See TracChangeset for help on using the changeset viewer.