source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPAU.m@ 619

PXRMLPAU        ; SLC/AGP - Reminder Patient List ;09/06/2007
        ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
        ;
        ;Main entry point for PXRM PATIENT LIST
START(IEN)      ;
        N PXRMDONE,VALMBCK,VALMSG,X,XMZ
        S X="IORESET"
        S VALMCNT=0
        D EN^VALM("PXRM PATIENT LIST AUTH USERS")
        W IORESET
        Q
        ;
BLDLIST ;
        N PLIST,PIEN
        K ^TMP("PXRMLPAU",$J)
        K ^TMP("PXRMLPAH",$J)
        D LIST(.PLIST,.PIEN)
        I $D(PLIST)=0 G EXIT
        M ^TMP("PXRMLPAU",$J)=PLIST
        S VALMCNT=PLIST("VALMCNT")
        F IND=1:1:VALMCNT D
        .S ^TMP("PXRMLPAU",$J,"IDX",IND,IND)=PIEN(IND)
        Q
        ;
LIST(RLIST,PIEN)        ;Build a list of patient list users.
        N ACCESS,ARRAY,COUNT,DATE,DFN,IND,SIEN,FNAME,NAME,NODE,LEVEL
        ;Build the list in alphabetical order.
        S VALMCNT=0
        S DFN=""
        F  S DFN=$O(^PXRMXP(810.5,IEN,40,"B",DFN)) Q:DFN=""  D
        .S IND=""
        .F  S IND=$O(^PXRMXP(810.5,IEN,40,"B",DFN,IND)) Q:'IND  D
        ..S ACCESS=$P($G(^PXRMXP(810.5,IEN,40,IND,0)),U,2)
        ..S FNAME=$$GET1^DIQ(200,DFN,.01) Q:$G(FNAME)=""
        ..S ARRAY(FNAME)=$G(IND)_U_$G(ACCESS)
        I $D(ARRAY)=0 Q
        S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  D
        .S VALMCNT=VALMCNT+1
        .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,$P($G(ARRAY(NAME)),U,2))
        .S PIEN(VALMCNT)=$P($G(ARRAY(NAME)),U)
        S RLIST("VALMCNT")=VALMCNT
        Q
        ;
FRE(NUMBER,NAME,ACCESS) ;Format  entry number, name, source,
        ;and date packed.
        N TEMP,TNAME,TSOURCE
        S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
        S TNAME=$E(NAME,1,45)
        S TEMP=TEMP_"  "_TNAME
        S TEMP=$$LJ^XLFSTR(TEMP,40," ")_ACCESS
        Q TEMP
        ;
ENTRY   ;Entry code
        D BLDLIST,XQORM
        Q
        ;
EXIT    ;Exit code
        K ^TMP("PXRMLPAU",$J)
        K ^TMP("PXRMLPAH",$J)
        D CLEAN^VALM10
        D FULL^VALM1
        Q
        ;
HDR     ; Header code
        S VALMHDR(1)="Available Patient Lists."
        S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
        Q
        ;
HLP     ;Help code
        N ORU,ORUPRMT,SUB,XQORM
        S SUB="PXRMLPAH"
        D EN^VALM("PXRM PATIENT LIST HELP")
        Q
        ;
INIT    ;Init
        S VALMCNT=0
        Q
        ;
PEXIT   ;PXRM MENU protocol exit code
        S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"
        ;Reset after page up/down etc
        D XQORM
        Q
        ;
ADD     ;add a user
        N CREAT,CNT,DIC,DIE,FDA,MSG,USER,Y
        S CREAT=$P($G(^PXRMXP(810.5,IEN,0)),U,7)
        I $G(CREAT)'=DUZ D  G ADDE
        . W !,"Only the creator of this list can add an user." H 2
        D FULL^VALM1
        S DIC="^VA(200,"
        S DIC(0)="QAEB"
        S DIC("A")="Select Users: "
        D ^DIC
        I Y=-1 Q
        S USER=+Y
        K Y
        K DIROUT,DIRUT,DTOUT,DUOUT
        S DIR(0)="S^F:Full Control;V:View Only"
        S DIR("A")="Select level of control: "
        S DIR("B")="V"
        S DIR("?")="Enter F or V. For detailed help type ??"
        W !
        D ^DIR K DIR
        I $D(DIROUT) S DTOUT=1
        I $D(DTOUT)!($D(DUOUT)) Q
        I $G(Y)="" W !,"A level of control must be entered." H 2 Q
        S YESNO=$E(Y(0))
        S FDA(810.54,"+2,"_IEN_",",.01)=USER
        S FDA(810.54,"+2,"_IEN_",",1)=Y
        D UPDATE^DIE("","FDA","","MSG")
        I $D(MSG)>0 D AWRITE^PXRMUTIL("MSG") H 2
ADDE    ;
        D BLDLIST
        S VALMBCK="R"
        Q
        ;
XQORM   ;
        S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST AUTH USER SELECT",0))_U_"1:"_VALMCNT
        S XQORM("A")="Select Item: "
        Q
        ;
XSEL    ;PXRM SELECT COMPONENT validation
        N EPIEN,LISTIEN,LRIEN,SEL
        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 patient list ien
        S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",SEL,SEL)
        ;Full screen mode
        D FULL^VALM1
        D PDELETE
        ;
        ;Option to Install, Delete or Install History
        ;
        S VALMBCK="R"
        Q
        ;
HELP(CALL)      ;General help text routine
        N HTEXT
        I CALL=1 D
        .S HTEXT(1)="Select CO to copy the patient list.\\"
        .S HTEXT(2)="Select COE to copy the patient list to an OE/RR Team.\\"
        .S HTEXT(3)="Select DE to delete the patient list.\\"
        .S HTEXT(4)="Select DSP to display the patient list.\\"
        D HELP^PXRMEUT(.HTEXT)
        Q
        ;
PDELETE ;Patient list delete
        ;
        ;Full Screen
        W IORESET
        ;
        N CREAT,IND,LISTIEN,NODE
        I DUZ'=$P($G(^PXRMXP(810.5,IEN,0)),U,7) D  G PDELEX
        .W !,"Only the creator of this list can delete it." H 2
        D EN^VALM2(XQORNOD(0))
        ;If there is no list quit.
        I '$D(VALMY) D BLDLIST S VALMBCK="R" Q
        S IND="",PXRMDONE=0
        F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
        .;Get the patient list ien.
        .S LISTIEN=^TMP("PXRMLPAU",$J,"IDX",IND,IND)
        .S DA(1)=IEN,DA=LISTIEN,DIK="^PXRMXP(810.5,"_DA(1)_",40," D ^DIK
        .W !,"Patient list deleted"
        ;
PDELEX  ;
        D BLDLIST
        ;
        S VALMBCK="R"
        Q
        ;