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

PXRMLPU.m

Go to the documentation of this file. 
  1. PXRMLPU ; SLC/PKR/PJH - Reminder Patient List ;10/11/2007
  1.  ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
  1.  ;
  1.  ;Main entry point for PXRM PATIENT LIST
  1. START(MODE) ;
  1.  N PXRMDONE,VALMBCK,VALMSG,X,XMZ,MODE1
  1.  S X="IORESET"
  1.  D ENDR^%ZISS
  1.  S VALMCNT=0
  1.  D EN^VALM("PXRM PATIENT LIST USER")
  1.  W IORESET
  1.  D KILL^%ZISS
  1.  Q
  1.  ;
  1. ACCESS(IEN,NODE) ;
  1.  ;Holders of the PXRM MANAGER key have full access to all lists.
  1.  ;DBIA #10076
  1.  I $D(^XUSEC("PXRM MANAGER",DUZ)) Q "F"
  1.  N ACCESS,TYPE
  1.  I $G(NODE)="" S NODE=$G(^PXRMXP(810.5,IEN,0))
  1.  S TYPE=$P(NODE,U,8)
  1.  I TYPE="" Q "F"
  1.  I TYPE="PUB" Q "F"
  1.  I $P(NODE,U,7)=DUZ Q "F"
  1.  S ACCESS="N"
  1.  I TYPE="PVT",$D(^PXRMXP(810.5,IEN,40,"B",DUZ)) D
  1.  . N USIEN,STATUS
  1.  . S USIEN=$O(^PXRMXP(810.5,IEN,40,"B",DUZ,""))
  1.  . S ACCESS=$S(USIEN="":"N",1:$P(^PXRMXP(810.5,IEN,40,USIEN,0),U,2))
  1.  Q ACCESS
  1.  ;
  1. BLDLIST ;
  1.  N PLIST
  1.  K ^TMP("PXRMLPU",$J)
  1.  K ^TMP("PXRMLPUH",$J)
  1.  S PLIST="PXRMLPU"
  1.  D LIST(MODE,PLIST)
  1.  S VALMCNT=+$G(^TMP("PXRMLPU",$J,"VALMCNT"))
  1.  Q
  1.  ;
  1. ENTRY ;Entry code
  1.  ;MODE=0 ORDER BY NAME
  1.  ;MODE=1 ORDER BY TYPE
  1.  I $G(MODE)'>0 S MODE=0
  1.  D BLDLIST,XQORM
  1.  Q
  1.  ;
  1. EXIT ;Exit code
  1.  K ^TMP("PXRMLPU",$J)
  1.  K ^TMP("PXRMLPUH",$J)
  1.  D CLEAN^VALM10
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. HDR ; Header code
  1.  N NAME
  1.  S VALMHDR(1)="Available Patient Lists."
  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 DCD to display creation documentation.\\"
  1.  .S HTEXT(5)="Select DSP to display the patient list.\\"
  1.  D HELP^PXRMEUT(.HTEXT)
  1.  Q
  1.  ;
  1. HLP ;Help code
  1.  N ORU,ORUPRMT,SUB,XQORM
  1.  S SUB="PXRMLPUH"
  1.  D EN^VALM("PXRM PATIENT LIST HELP")
  1.  Q
  1.  ;
  1. INIT ;Init
  1.  S VALMCNT=0
  1.  Q
  1.  ;
  1. LIST(MODE,PLIST) ;Build a list of patient list entries.
  1.  N ACCESS,COUNT,DATA,DATE,IND,FMTSTR,FNAME,OUTPUT,NAME,NL,NUM
  1.  N STR,SUB,TYPE
  1.  S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLRRC")
  1.  ;MODE=0 build list in alphabetical order
  1.  ;MODE=1 build list by type of list.
  1.  K ^TMP($J,PLIST),^TMP(PLIST,$J)
  1.  S VALMCNT=0,NAME="",NUM=0,TYPE=""
  1.  F  S NAME=$O(^PXRMXP(810.5,"B",NAME)) Q:NAME=""  D
  1.  .S IND="" F  S IND=$O(^PXRMXP(810.5,"B",NAME,IND)) Q:'IND  D
  1.  ..S DATA=$G(^PXRMXP(810.5,IND,0))
  1.  ..S ACCESS=$$ACCESS(IND,DATA)
  1.  ..I ACCESS="N" Q
  1.  ..S FNAME=$P($G(DATA),U),DATE=$P($G(DATA),U,4)
  1.  ..S COUNT=+$P($G(^PXRMXP(810.5,IND,30,0)),U,4)
  1.  ..S TYPE=$P(DATA,U,8)
  1.  ..S SUB=$S(MODE=0:"NAME",1:TYPE)
  1.  ..S ^TMP($J,PLIST,SUB,FNAME)=IND_U_DATE_U_COUNT_U_TYPE_U_ACCESS
  1.  I '$D(^TMP($J,PLIST)) Q
  1.  ;Loop through ARRAY to populate the output list
  1.  ;sub is either the type of list or 'NAME'. If sort is
  1.  ;by TYPE show PVT lists first.
  1.  S SUB=""
  1.  F  S SUB=$O(^TMP($J,PLIST,SUB),-1) Q:SUB=""  D
  1.  . S FNAME=""
  1.  . F  S FNAME=$O(^TMP($J,PLIST,SUB,FNAME)) Q:FNAME=""  D
  1.  .. S DATA=^TMP($J,PLIST,SUB,FNAME),NUM=NUM+1
  1.  .. S ^TMP("PXRMLPU",$J,"SEL",NUM)=$P(DATA,U,1)
  1.  .. S DATE=$P(DATA,U,2),DATE=$$FMTE^XLFDT(DATE,2)
  1.  .. S $P(DATA,U,2)=DATE
  1.  .. S STR=NUM_U_FNAME_U_$P(DATA,U,2,5)
  1.  .. D COLFMT^PXRMTEXT(FMTSTR,STR," ",.NL,.OUTPUT)
  1.  .. F IND=1:1:NL D
  1.  ... S VALMCNT=VALMCNT+1,^TMP(PLIST,$J,VALMCNT,0)=OUTPUT(IND)
  1.  ... S ^TMP("PXRMLPU",$J,"IDX",VALMCNT,NUM)=""
  1.  S ^TMP(PLIST,$J,"VALMCNT")=VALMCNT
  1.  K ^TMP($J,PLIST)
  1.  Q
  1.  ;
  1. PCOPY ;Patient list copy
  1.  S SUB="PXRMLPU"
  1.  D PCOPY1(SUB)
  1.  D BLDLIST
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. PCOPY1(SUB) ;
  1.  ;Full Screen
  1.  W IORESET
  1.  N IND,LISTIEN,VALMY
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) 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(SUB,$J,"SEL",IND)
  1.  .D COPY^PXRMRUL1(LISTIEN)
  1.  Q
  1.  ;
  1. PDELETE ;Patient list delete
  1.  ;Full Screen
  1.  W IORESET
  1.  N DELOK,IND,LISTIEN,NODE,VALMY
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) 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("PXRMLPU",$J,"SEL",IND)
  1.  .S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
  1.  .S DELOK=$$LDELOK^PXRMEUT(LISTIEN)
  1.  .I DELOK D DELETE^PXRMRUL1(LISTIEN) Q
  1.  .E  D  Q
  1.  ..W !,"In order to delete a list you must be the creator or a Reminder Manager!"
  1.  ..S PXRMDONE=1 H 2
  1.  D BLDLIST
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. PEXIT ;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. POERR ;Patient list copy to OERR Team (#101.21)
  1.  ;Full Screen
  1.  W IORESET
  1.  N ACCESS,IND,LISTIEN,NODE,USIEN,VALMY
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) 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("PXRMLPU",$J,"SEL",IND)
  1.  .S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
  1.  .S ACCESS=$$ACCESS^PXRMLPU(LISTIEN,NODE)
  1.  .I ACCESS="F" D OERR^PXRMLPOE(LISTIEN)
  1.  .I ACCESS="N" D
  1.  ..W !,"The list cannot be copied; you must have full access to copy the list to an OE/RR team!"
  1.  ..S PXRMDONE=1 H 2
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. PLIST ;Patient list inquiry.
  1.  N CREAT,NAME,IND,LISTIEN,USIEN,VALMY,CREAT,NODE,TRUE
  1.  D EN^VALM2(XQORNOD(0))
  1.  ;If there is no list quit.
  1.  I '$D(VALMY) Q
  1.  ;PXRMDONE is newed in PXRMLPU
  1.  S PXRMDONE=0
  1.  S IND=""
  1.  F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
  1.  .S LISTIEN=^TMP("PXRMLPU",$J,"SEL",IND)
  1.  .D START^PXRMLPP(LISTIEN)
  1.  D BLDLIST
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. VIEW ;
  1.  D FULL^VALM1
  1.  N DIR,DTOUT,DUOUT,DIROUT,DIROUT,Y
  1.  S DIR(0)="SO^N:NAME;T:TYPE"
  1.  S DIR("A")="Select View Type"
  1.  D ^DIR
  1.  I $D(DTOUT),$D(DUOUT),$D(DIROUT) Q
  1.  I Y="N" S MODE=0 D ENTRY
  1.  I Y="T" S MODE=1 D ENTRY
  1.  Q
  1.  ;
  1. XQORM ;
  1.  S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST USER SELECT ENTRY",0))_U_"1:"_VALMCNT
  1.  S XQORM("A")="Select Item: "
  1.  Q
  1.  ;
  1. XSEL ;SELECT validation
  1.  N EPIEN,LEVEL,LISTIEN,LRIEN,NODE,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@("SEL",SEL))) D  Q
  1.  .W $C(7),!,SEL_" is not a valid item number." H 2
  1.  .S VALMBCK="R"
  1.  ;
  1.  ;Get the patient list ien
  1.  S LISTIEN=^TMP("PXRMLPU",$J,"SEL",SEL)
  1.  ;Get extract definition ien (if present)
  1.  S EPIEN=$P($G(^PXRMXP(810.5,LISTIEN,0)),U,5)
  1.  ;Get list rule ien
  1.  S LRIEN=$P($G(^PXRMXP(810.5,LISTIEN,0)),U,6)
  1.  S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
  1.  ;
  1.  ;Full screen mode
  1.  D FULL^VALM1
  1.  ;
  1.  ;Option to Install, Delete or Install History
  1.  N ACCESS,DELOK,DIR,OPTION,RIEN,X,Y
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S ACCESS=$$ACCESS(LISTIEN,NODE)
  1.  S DELOK=$$LDELOK^PXRMEUT(LISTIEN)
  1.  S DIR(0)="SBM"_U_"CO:Copy Patient List;"
  1.  S DIR(0)=DIR(0)_"COE:Copy to OE/RR Team;"
  1.  I DELOK S DIR(0)=DIR(0)_"DE:Delete Patient List;"
  1.  S DIR(0)=DIR(0)_"DCD:Display Creation Documentation;"
  1.  S DIR(0)=DIR(0)_"DSP:Display Patient List;"
  1.  S DIR("A")="Select Action: "
  1.  S DIR("B")="DSP"
  1.  S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMLPU(1)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
  1.  S OPTION=Y
  1.  ;
  1.  I $G(OPTION)="" G XSELE
  1.  ;
  1.  ;Copy patient list
  1.  I OPTION="CO" D COPY^PXRMRUL1(LISTIEN)
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1.  ;Copy to OE/RR Team
  1.  I OPTION="COE" D OERR^PXRMLPOE(LISTIEN)
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1.  ;Delete patient list
  1.  I OPTION="DE" D PDELETE
  1.  ;
  1.  ;Display creation documentation
  1.  I OPTION="DCD" D EN^PXRMLCD(LISTIEN)
  1.  ;
  1.  ;Display patient list
  1.  I OPTION="DSP" D START^PXRMLPP(LISTIEN)
  1.  ;
  1. XSELE ;
  1.  D CLEAN^VALM10
  1.  D BLDLIST,XQORM
  1.  S VALMBCK="R"
  1.  Q