source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLPU.m@ 1611

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