source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m@ 636

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