Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m	(revision 623)
@@ -1,286 +1,295 @@
-PXRMLPU	; SLC/PKR/PJH - Reminder Patient List ;10/11/2007
-	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-	;
-	;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 PLIST
-	K ^TMP("PXRMLPU",$J)
-	K ^TMP("PXRMLPUH",$J)
-	S PLIST="PXRMLPU"
-	D LIST(MODE,PLIST)
-	S VALMCNT=+$G(^TMP("PXRMLPU",$J,"VALMCNT"))
-	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
-	;
-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 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 DCD to display creation documentation.\\"
-	.S HTEXT(5)="Select DSP to display the 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)	;Build a list of patient list entries.
-	N ACCESS,COUNT,DATA,DATE,IND,FMTSTR,FNAME,OUTPUT,NAME,NL,NUM
-	N STR,SUB,TYPE
-	S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLRRC")
-	;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="",NUM=0,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 DATA=$G(^PXRMXP(810.5,IND,0))
-	..S ACCESS=$$ACCESS(IND,DATA)
-	..I ACCESS="N" Q
-	..S FNAME=$P($G(DATA),U),DATE=$P($G(DATA),U,4)
-	..S COUNT=+$P($G(^PXRMXP(810.5,IND,30,0)),U,4)
-	..S TYPE=$P(DATA,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 DATA=^TMP($J,PLIST,SUB,FNAME),NUM=NUM+1
-	.. S ^TMP("PXRMLPU",$J,"SEL",NUM)=$P(DATA,U,1)
-	.. S DATE=$P(DATA,U,2),DATE=$$FMTE^XLFDT(DATE,2)
-	.. S $P(DATA,U,2)=DATE
-	.. S STR=NUM_U_FNAME_U_$P(DATA,U,2,5)
-	.. D COLFMT^PXRMTEXT(FMTSTR,STR," ",.NL,.OUTPUT)
-	.. F IND=1:1:NL D
-	... S VALMCNT=VALMCNT+1,^TMP(PLIST,$J,VALMCNT,0)=OUTPUT(IND)
-	... S ^TMP("PXRMLPU",$J,"IDX",VALMCNT,NUM)=""
-	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,"SEL",IND)
-	.D COPY^PXRMRUL1(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,"SEL",IND)
-	.S NODE=$G(^PXRMXP(810.5,LISTIEN,0))
-	.S DELOK=$$LDELOK^PXRMEUT(LISTIEN)
-	.I DELOK D DELETE^PXRMRUL1(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,"SEL",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,"SEL",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@("SEL",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,"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^PXRMLPU(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^PXRMRUL1(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
+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
