Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (15 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m (modified) (1 diff)

WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m

@@ -1 @@
-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