Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMLPAU

PXRMLPAU.m

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