238 lines
6.5 KiB
Mathematica
238 lines
6.5 KiB
Mathematica
PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;01/06/2006
|
|
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|
;
|
|
;Main entry point for PXRM PATIENT LIST
|
|
START(IEN) ;
|
|
N CDATE,CLASS,CREATOR,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")
|
|
;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,NAME,INST,DFN) ;Format entry number, name and primary station
|
|
N TEMP,TNAME,TSOURCE
|
|
S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
|
|
S TNAME=$E(NAME,1,30)
|
|
S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,32," ")
|
|
S TEMP=TEMP_" "_$$LJ^XLFSTR(DFN,15," ")
|
|
I INST'="" S TEMP=TEMP_" "_INST
|
|
Q TEMP
|
|
;
|
|
HDR ; Header code
|
|
S VALMHDR(1)="List Name: "_LNAME_" ("_VALMCNT_" patients)"
|
|
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 VALMSG="+ Next Screen - Prev Screen ?? More Actions"
|
|
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)
|
|
.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,DFN,IND,INST,NEXT,PNAME,SUB
|
|
;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
|
|
.;#DBIA 10035
|
|
.S PNAME=$P($G(^DPT(DFN,0)),U,1)
|
|
.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)=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
|
|
...I INCINST S INST=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)
|
|
...S VALMCNT=VALMCNT+1
|
|
...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,INST,DFN)
|
|
...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
|
|
;
|