PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;Main entry point for PXRM PATIENT LIST
START(IEN) ;
N CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE
N VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
;Get Patient List record and associated data.
S LDATA=$G(^PXRMXP(810.5,IEN,0))
S LNAME=$P(LDATA,U,1)
S CDATE=$P(LDATA,U,4)
S SOURCE=$P(LDATA,U,5),SNAME=""
;Check if generated from #810.2
I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)
;If not check if generated from #810.4
I SNAME="" D
. S SOURCE=$P(LDATA,U,6)
. I SOURCE'="" S SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)
;If still no source check for created from Reminder Due Report.
I SNAME="" D
. S SOURCE=$P(LDATA,U,9)
. I SOURCE'="" S SNAME="Reminder Due Report"
;If there still is no source then assume it was generated in the
;past by a Reminder Due Report.
I SNAME="" S SNAME="Reminder Due Report"
;Creator
S CREATOR=+$P(LDATA,U,7)
S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
;Type
S TYPE=$P(LDATA,U,8)
S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
;Class
S CLASS=$P($G(^PXRMXP(810.5,IEN,100)),U)
S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
S INDP=$P(LDATA,U,11)
S INTP=$P(LDATA,U,12)
;Default view by name.
S PXRMVIEW="N"
S VALMCNT=0
D EN^VALM("PXRM PATIENT LIST PATIENTS")
Q
;
BLDLIST(IEN) ;Build a list of all patients
N IND,INCINST
S INCINST=+$P(^PXRMXP(810.5,IEN,0),U,10)
I 'INCINST D CHGCAP^VALM("HEADER3","")
K ^TMP("PXRMLPP",$J),^TMP("PXRMLPPA",$J),^TMP("PXRMLPPI",$J)
D LIST(.VALMCNT,.IEN,INCINST)
F IND=1:1:VALMCNT D
.S ^TMP("PXRMLPP",$J,"IDX",IND,IND)=^TMP("PXRMLPPI",$J,IND)
K ^TMP("PXRMLPPI",$J)
Q
DEM ;
D FULL^VALM1
D EN^PXRMPDR(IEN)
S VALMBCK="R"
Q
;
EDIT ;Edit selected patient list fields.
N DA,DIE,DR,TEMP
S DA=IEN,DIE="^PXRMXP(810.5,"
S DR=".01;.08"
I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR=DR_";.07"
D ^DIE
S TEMP=^PXRMXP(810.5,IEN,0)
S LNAME=$P(TEMP,U,1),CREATOR=$P(TEMP,U,7),TYPE=$P(TEMP,U,8)
S CREATOR=$P(^VA(200,CREATOR,0),U,1)
D HDR^PXRMLPP
S VALMBCK="R"
Q
;
EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if
;the user is permitted to edit the selected patient list.
I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1
N CREATOR
S CREATOR=$P(^PXRMXP(810.5,IEN,0),U,7)
Q $S(CREATOR=DUZ:1,1:0)
;
ENTRY ;Entry code
D BLDLIST(IEN)
D XQORM
Q
;
EXIT ;Exit code
K ^TMP("PXRMLPP",$J)
K ^TMP("PXRMLPPH",$J)
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="R"
Q
;
FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST) ;Format entry number, name, primary
;station and deceased, test information.
N TEMP,TEXT,TNAME,TSOURCE
S TEXT=$$RJ^XLFSTR(NUMBER,5," ")
S TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")
S TEXT=TEXT_" "_$$LJ^XLFSTR(DFN,15," ")
S TEMP=""
I DECEASED S TEMP=" (D)"
I TESTP S TEMP=" (T)"
I DECEASED,TESTP S TEMP=" (DP)"
S TEXT=TEXT_TEMP
I INST'="" S TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")
Q TEXT
;
HDR ; Header code
N TEXT
S VALMHDR(1)="List Name: "_LNAME
S VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
S VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR
S VALMHDR(3)=" Class: "_CLASS
S VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE
S VALMHDR(4)=" Source: "_SNAME
S VALMHDR(5)=" Number of patients: "_VALMCNT
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
S TEXT=""
I INDP S TEXT=" (D=deceased)"
I INTP S TEXT=" (T=test)"
I INDP,INTP S TEXT=" (D=deceased, T=test)"
S TEXT="DFN"_TEXT
D CHGCAP^VALM("HEADER2",TEXT)
Q
;
HLP ;Help code
N ORU,ORUPRMT,SUB,XQORM
S SUB="PXRMLPPH"
D EN^VALM("PXRM PATIENT LIST HELP")
Q
HSA ;Print Health Summary for all patients on list
D HSA^PXRMLPHS(IEN)
S VALMBCK="R"
Q
;
HSI ;Print Health Summary for selected patients.
;Full Screen
W IORESET
N IND,DFN,PLNODE,PNAME,VALMY
D EN^VALM2(XQORNOD(0))
;If there is no list quit.
I '$D(VALMY) Q
S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT
K ^XTMP(PLNODE)
S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
S IND="",PXRMDONE=0
F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
.;Get the patient list ien.
.S DFN=^TMP("PXRMLPP",$J,"IDX",IND,IND)
.;DBIA #10035
.S PNAME=$P(^DPT(DFN,0),U,1)
.I PNAME="" S PNAME=DFN_" does not exist"
.S ^XTMP(PLNODE,PNAME)=DFN
D HSI^PXRMLPHS(PLNODE)
S VALMBCK="R"
Q
;
INIT ;Init
S VALMCNT=0
Q
;
LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.
N DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP
;Build the ordered list.
S IND=0,SUB="NAME"
F S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND D
.S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""
.S DFN=$P(DATA,U) Q:'DFN
.S DECEASED=$P(DATA,U,4)
.S TESTP=$P(DATA,U,5)
.;#DBIA 10035
.S PNAME=$P($G(^DPT(DFN,0)),U,1)
.I PNAME="" S PNAME=DFN_" does not exist"
.S INSTNUM=$P(DATA,U,2) S:INSTNUM="" INSTNUM="NONE"
.S INST=$P(DATA,U,3)
.;Lists built before PXRM*2*4 will only have the Institution ien.
.I INST="" S INST=$P(DATA,U,2)
.I INST="" S INST="NONE"
.I PXRMVIEW="I" S SUB=INST
.S ^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST
;Transfer to list manager array
S SUB="",VALMCNT=0
F S SUB=$O(^TMP("PXRMLPPA",$J,SUB)) Q:SUB="" D
.S (INST,PNAME)=""
.F S PNAME=$O(^TMP("PXRMLPPA",$J,SUB,PNAME)) Q:PNAME="" D
..S DFN=""
..F S DFN=$O(^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)) Q:DFN="" D
...S DATA=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)
...S DECEASED=$P(DATA,U,1)
...S TESTP=$P(DATA,U,2)
...I INCINST S INST=$P(DATA,U,3)
...S VALMCNT=VALMCNT+1
...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)
...S ^TMP("PXRMLPPI",$J,VALMCNT)=DFN
K ^TMP("PXRMLPPA",$J)
Q
;
PEXIT ;PXRM PATIENT LIST PATIENTS MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
D XQORM
Q
;
USER ;
I $P($G(^PXRMXP(810.5,IEN,0)),U,8)="PUB" D FULL^VALM1 W !,"This option is locked for Public Lists." H 2 Q
D FULL^VALM1
D START^PXRMLPAU(IEN)
S VALMBCK="R"
Q
;
USR(IEN) ;Screen for protocol PXRM PATIENT LIST AUTH USER
N TYPE
S TYPE=$P(^PXRMXP(810.5,IEN,0),U,8)
;Public lists cannot have individual user access.
I TYPE="PUB" Q "N"
Q $$ACCESS^PXRMLPU(IEN)
;
VIEW ;Select view
W IORESET
S VALMBCK="R",VALMBG=1
N X,Y,CODE,DIR
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="S"_U_"I:Sort by Institution and Name;"
S DIR(0)=DIR(0)_"N:Sort by Name;"
S DIR("A")="TYPE OF VIEW"
S DIR("B")=$S(PXRMVIEW="N":"I",1:"N")
S DIR("?")="Select from the codes displayed."
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
;Change display type
S PXRMVIEW=Y
;Rebuild Workfile
D BLDLIST^PXRMLPP(IEN),HDR
Q
;
XSEL ;PXRM PATIENT LIST PATIENT SELECT validation
N EPIEN,DFN,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 DFN=^TMP("PXRMLPP",$J,"IDX",SEL,SEL)
;Full screen mode
D FULL^VALM1
;Print individual Health Summary
D HSI^PXRMLPHS(DFN)
S VALMBCK="R"
Q
;
XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT
S XQORM("A")="Select Item: "
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLPP 7575 printed Oct 16, 2024@17:47:26 Page 2
PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;Main entry point for PXRM PATIENT LIST
START(IEN) ;
+1 NEW CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE
+2 NEW VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
+3 ;Get Patient List record and associated data.
+4 SET LDATA=$GET(^PXRMXP(810.5,IEN,0))
+5 SET LNAME=$PIECE(LDATA,U,1)
+6 SET CDATE=$PIECE(LDATA,U,4)
+7 SET SOURCE=$PIECE(LDATA,U,5)
SET SNAME=""
+8 ;Check if generated from #810.2
+9 IF SOURCE
SET SNAME="Extract Parameter - "_$PIECE($GET(^PXRM(810.2,SOURCE,0)),U)
+10 ;If not check if generated from #810.4
+11 IF SNAME=""
Begin DoDot:1
+12 SET SOURCE=$PIECE(LDATA,U,6)
+13 IF SOURCE'=""
SET SNAME="List Rule - "_$PIECE($GET(^PXRM(810.4,SOURCE,0)),U)
End DoDot:1
+14 ;If still no source check for created from Reminder Due Report.
+15 IF SNAME=""
Begin DoDot:1
+16 SET SOURCE=$PIECE(LDATA,U,9)
+17 IF SOURCE'=""
SET SNAME="Reminder Due Report"
End DoDot:1
+18 ;If there still is no source then assume it was generated in the
+19 ;past by a Reminder Due Report.
+20 IF SNAME=""
SET SNAME="Reminder Due Report"
+21 ;Creator
+22 SET CREATOR=+$PIECE(LDATA,U,7)
+23 SET CREATOR=$SELECT(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
+24 ;Type
+25 SET TYPE=$PIECE(LDATA,U,8)
+26 SET TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
+27 ;Class
+28 SET CLASS=$PIECE($GET(^PXRMXP(810.5,IEN,100)),U)
+29 SET CLASS=$SELECT(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
+30 SET INDP=$PIECE(LDATA,U,11)
+31 SET INTP=$PIECE(LDATA,U,12)
+32 ;Default view by name.
+33 SET PXRMVIEW="N"
+34 SET VALMCNT=0
+35 DO EN^VALM("PXRM PATIENT LIST PATIENTS")
+36 QUIT
+37 ;
BLDLIST(IEN) ;Build a list of all patients
+1 NEW IND,INCINST
+2 SET INCINST=+$PIECE(^PXRMXP(810.5,IEN,0),U,10)
+3 IF 'INCINST
DO CHGCAP^VALM("HEADER3","")
+4 KILL ^TMP("PXRMLPP",$JOB),^TMP("PXRMLPPA",$JOB),^TMP("PXRMLPPI",$JOB)
+5 DO LIST(.VALMCNT,.IEN,INCINST)
+6 FOR IND=1:1:VALMCNT
Begin DoDot:1
+7 SET ^TMP("PXRMLPP",$JOB,"IDX",IND,IND)=^TMP("PXRMLPPI",$JOB,IND)
End DoDot:1
+8 KILL ^TMP("PXRMLPPI",$JOB)
+9 QUIT
DEM ;
+1 DO FULL^VALM1
+2 DO EN^PXRMPDR(IEN)
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
EDIT ;Edit selected patient list fields.
+1 NEW DA,DIE,DR,TEMP
+2 SET DA=IEN
SET DIE="^PXRMXP(810.5,"
+3 SET DR=".01;.08"
+4 IF $DATA(^XUSEC("PXRM MANAGER",DUZ))
SET DR=DR_";.07"
+5 DO ^DIE
+6 SET TEMP=^PXRMXP(810.5,IEN,0)
+7 SET LNAME=$PIECE(TEMP,U,1)
SET CREATOR=$PIECE(TEMP,U,7)
SET TYPE=$PIECE(TEMP,U,8)
+8 SET CREATOR=$PIECE(^VA(200,CREATOR,0),U,1)
+9 DO HDR^PXRMLPP
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if
+1 ;the user is permitted to edit the selected patient list.
+2 IF $DATA(^XUSEC("PXRM MANAGER",DUZ))
QUIT 1
+3 NEW CREATOR
+4 SET CREATOR=$PIECE(^PXRMXP(810.5,IEN,0),U,7)
+5 QUIT $SELECT(CREATOR=DUZ:1,1:0)
+6 ;
ENTRY ;Entry code
+1 DO BLDLIST(IEN)
+2 DO XQORM
+3 QUIT
+4 ;
EXIT ;Exit code
+1 KILL ^TMP("PXRMLPP",$JOB)
+2 KILL ^TMP("PXRMLPPH",$JOB)
+3 DO CLEAN^VALM10
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST) ;Format entry number, name, primary
+1 ;station and deceased, test information.
+2 NEW TEMP,TEXT,TNAME,TSOURCE
+3 SET TEXT=$$RJ^XLFSTR(NUMBER,5," ")
+4 SET TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")
+5 SET TEXT=TEXT_" "_$$LJ^XLFSTR(DFN,15," ")
+6 SET TEMP=""
+7 IF DECEASED
SET TEMP=" (D)"
+8 IF TESTP
SET TEMP=" (T)"
+9 IF DECEASED
IF TESTP
SET TEMP=" (DP)"
+10 SET TEXT=TEXT_TEMP
+11 IF INST'=""
SET TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")
+12 QUIT TEXT
+13 ;
HDR ; Header code
+1 NEW TEXT
+2 SET VALMHDR(1)="List Name: "_LNAME
+3 SET VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
+4 SET VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR
+5 SET VALMHDR(3)=" Class: "_CLASS
+6 SET VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE
+7 SET VALMHDR(4)=" Source: "_SNAME
+8 SET VALMHDR(5)=" Number of patients: "_VALMCNT
+9 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+10 SET TEXT=""
+11 IF INDP
SET TEXT=" (D=deceased)"
+12 IF INTP
SET TEXT=" (T=test)"
+13 IF INDP
IF INTP
SET TEXT=" (D=deceased, T=test)"
+14 SET TEXT="DFN"_TEXT
+15 DO CHGCAP^VALM("HEADER2",TEXT)
+16 QUIT
+17 ;
HLP ;Help code
+1 NEW ORU,ORUPRMT,SUB,XQORM
+2 SET SUB="PXRMLPPH"
+3 DO EN^VALM("PXRM PATIENT LIST HELP")
+4 QUIT
HSA ;Print Health Summary for all patients on list
+1 DO HSA^PXRMLPHS(IEN)
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
HSI ;Print Health Summary for selected patients.
+1 ;Full Screen
+2 WRITE IORESET
+3 NEW IND,DFN,PLNODE,PNAME,VALMY
+4 DO EN^VALM2(XQORNOD(0))
+5 ;If there is no list quit.
+6 IF '$DATA(VALMY)
QUIT
+7 SET PLNODE="PXRMLPHS"_$JOB_$$NOW^XLFDT
+8 KILL ^XTMP(PLNODE)
+9 SET ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
+10 SET IND=""
SET PXRMDONE=0
+11 FOR
SET IND=$ORDER(VALMY(IND))
if (+IND=0)!(PXRMDONE)
QUIT
Begin DoDot:1
+12 ;Get the patient list ien.
+13 SET DFN=^TMP("PXRMLPP",$JOB,"IDX",IND,IND)
+14 ;DBIA #10035
+15 SET PNAME=$PIECE(^DPT(DFN,0),U,1)
+16 IF PNAME=""
SET PNAME=DFN_" does not exist"
+17 SET ^XTMP(PLNODE,PNAME)=DFN
End DoDot:1
+18 DO HSI^PXRMLPHS(PLNODE)
+19 SET VALMBCK="R"
+20 QUIT
+21 ;
INIT ;Init
+1 SET VALMCNT=0
+2 QUIT
+3 ;
LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.
+1 NEW DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP
+2 ;Build the ordered list.
+3 SET IND=0
SET SUB="NAME"
+4 FOR
SET IND=$ORDER(^PXRMXP(810.5,IEN,30,IND))
if 'IND
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMXP(810.5,IEN,30,IND,0))
if DATA=""
QUIT
+6 SET DFN=$PIECE(DATA,U)
if 'DFN
QUIT
+7 SET DECEASED=$PIECE(DATA,U,4)
+8 SET TESTP=$PIECE(DATA,U,5)
+9 ;#DBIA 10035
+10 SET PNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+11 IF PNAME=""
SET PNAME=DFN_" does not exist"
+12 SET INSTNUM=$PIECE(DATA,U,2)
if INSTNUM=""
SET INSTNUM="NONE"
+13 SET INST=$PIECE(DATA,U,3)
+14 ;Lists built before PXRM*2*4 will only have the Institution ien.
+15 IF INST=""
SET INST=$PIECE(DATA,U,2)
+16 IF INST=""
SET INST="NONE"
+17 IF PXRMVIEW="I"
SET SUB=INST
+18 SET ^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST
End DoDot:1
+19 ;Transfer to list manager array
+20 SET SUB=""
SET VALMCNT=0
+21 FOR
SET SUB=$ORDER(^TMP("PXRMLPPA",$JOB,SUB))
if SUB=""
QUIT
Begin DoDot:1
+22 SET (INST,PNAME)=""
+23 FOR
SET PNAME=$ORDER(^TMP("PXRMLPPA",$JOB,SUB,PNAME))
if PNAME=""
QUIT
Begin DoDot:2
+24 SET DFN=""
+25 FOR
SET DFN=$ORDER(^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN))
if DFN=""
QUIT
Begin DoDot:3
+26 SET DATA=^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN)
+27 SET DECEASED=$PIECE(DATA,U,1)
+28 SET TESTP=$PIECE(DATA,U,2)
+29 IF INCINST
SET INST=$PIECE(DATA,U,3)
+30 SET VALMCNT=VALMCNT+1
+31 SET ^TMP("PXRMLPP",$JOB,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)
+32 SET ^TMP("PXRMLPPI",$JOB,VALMCNT)=DFN
End DoDot:3
End DoDot:2
End DoDot:1
+33 KILL ^TMP("PXRMLPPA",$JOB)
+34 QUIT
+35 ;
PEXIT ;PXRM PATIENT LIST PATIENTS MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 DO XQORM
+3 QUIT
+4 ;
USER ;
+1 IF $PIECE($GET(^PXRMXP(810.5,IEN,0)),U,8)="PUB"
DO FULL^VALM1
WRITE !,"This option is locked for Public Lists."
HANG 2
QUIT
+2 DO FULL^VALM1
+3 DO START^PXRMLPAU(IEN)
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
USR(IEN) ;Screen for protocol PXRM PATIENT LIST AUTH USER
+1 NEW TYPE
+2 SET TYPE=$PIECE(^PXRMXP(810.5,IEN,0),U,8)
+3 ;Public lists cannot have individual user access.
+4 IF TYPE="PUB"
QUIT "N"
+5 QUIT $$ACCESS^PXRMLPU(IEN)
+6 ;
VIEW ;Select view
+1 WRITE IORESET
+2 SET VALMBCK="R"
SET VALMBG=1
+3 NEW X,Y,CODE,DIR
+4 KILL DIROUT,DIRUT,DTOUT,DUOUT
+5 SET DIR(0)="S"_U_"I:Sort by Institution and Name;"
+6 SET DIR(0)=DIR(0)_"N:Sort by Name;"
+7 SET DIR("A")="TYPE OF VIEW"
+8 SET DIR("B")=$SELECT(PXRMVIEW="N":"I",1:"N")
+9 SET DIR("?")="Select from the codes displayed."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIROUT)
SET DTOUT=1
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+13 ;Change display type
+14 SET PXRMVIEW=Y
+15 ;Rebuild Workfile
+16 DO BLDLIST^PXRMLPP(IEN)
DO HDR
+17 QUIT
+18 ;
XSEL ;PXRM PATIENT LIST PATIENT SELECT validation
+1 NEW EPIEN,DFN,SEL
+2 SET SEL=$PIECE(XQORNOD(0),"=",2)
+3 ;Remove trailing ,
+4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
+5 ;Invalid selection
+6 IF SEL[","
Begin DoDot:1
+7 WRITE $CHAR(7),!,"Only one item number allowed."
HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("IDX",SEL)))
Begin DoDot:1
+10 WRITE $CHAR(7),!,SEL_" is not a valid item number."
HANG 2
+11 SET VALMBCK="R"
End DoDot:1
QUIT
+12 ;
+13 ;Get the patient list ien
+14 SET DFN=^TMP("PXRMLPP",$JOB,"IDX",SEL,SEL)
+15 ;Full screen mode
+16 DO FULL^VALM1
+17 ;Print individual Health Summary
+18 DO HSI^PXRMLPHS(DFN)
+19 SET VALMBCK="R"
+20 QUIT
+21 ;
XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT
+1 SET XQORM("A")="Select Item: "
+2 QUIT
+3 ;
