source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLPAU.m@ 628

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
 ;