239 lines
8.0 KiB
Mathematica
239 lines
8.0 KiB
Mathematica
|
PXRMRPCA ; SLC/PJH - Functions returning REMINDER data ;01/18/2005
|
||
|
|
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ALL(ORY) ;All active reminders
|
||
|
|
;print name^ien
|
||
|
|
N ARR,DATA,NAME,ORREM,OCNT,SUB,USAGE
|
||
|
|
S ORREM=0
|
||
|
|
F S ORREM=$O(^PXD(811.9,ORREM)) Q:'ORREM D
|
||
|
|
.;Include only CPRS reminders
|
||
|
|
.S USAGE=$P($G(^PXD(811.9,ORREM,100)),U,4) I USAGE["L" Q
|
||
|
|
.I USAGE'["C",USAGE'["*" Q
|
||
|
|
.S DATA=$G(^PXD(811.9,ORREM,0)) Q:DATA=""
|
||
|
|
.;Skip inactive reminders
|
||
|
|
.I $P(DATA,U,6) Q
|
||
|
|
.;Skip reminders with no name
|
||
|
|
.S NAME=$P(DATA,U,3) I NAME="" Q
|
||
|
|
.;Sort by name
|
||
|
|
.S ARR(NAME_U_ORREM)=""
|
||
|
|
; Build output arrray
|
||
|
|
S SUB="",OCNT=0
|
||
|
|
F S SUB=$O(ARR(SUB)) Q:SUB="" D
|
||
|
|
.S OCNT=OCNT+1
|
||
|
|
.S ORY(OCNT)=SUB
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
APPL(ORY,ORPT,ORLOC) ;Applicable reminders for cover sheet
|
||
|
|
;format file 811.9 ien^reminder print name^date due^last occur^prty^due.
|
||
|
|
N ORSRV,TMPLST,ERR,ORI,ORJ,ORIEN,ORTXT,ORX,ORLASTDT,ORDUEDT
|
||
|
|
N ORDUE,ORPRI,ORSTA,PASS
|
||
|
|
S ORJ=0
|
||
|
|
S ORSRV=$$GET1^DIQ(200,DUZ,29)
|
||
|
|
I ORLOC S PASS="USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
I 'ORLOC S PASS="USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
D GETLST^XPAR(.TMPLST,PASS,"ORQQPX SEARCH ITEMS","Q",.ERR) ; DBIA #3076
|
||
|
|
I ERR>0 S ORY(1)=U_"Error: "_$P(ERR,U,2) Q
|
||
|
|
D AVAL(.TMPLST,2) ;Evaluate reminders
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ALIST(ORY,ORPT,LIST) ;Evaluate specific reminders
|
||
|
|
N ORSRV,ORI,ORJ,ORIEN,ORTXT,ORX,ORLASTDT,ORDUEDT,ORLOC
|
||
|
|
N ORDUE,ORPRI,ORSTA
|
||
|
|
S ORJ=0
|
||
|
|
D AVAL(.LIST,1)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
AVAL(ARRAY,POS) ;Evaluate array of reminders
|
||
|
|
S ORI=0 F S ORI=$O(ARRAY(ORI)) Q:'ORI D
|
||
|
|
.S ORIEN=$P(ARRAY(ORI),U,POS)
|
||
|
|
.K ^TMP("PXRHM",$J)
|
||
|
|
. I $$INACTIVE^PXRM(ORIEN) Q
|
||
|
|
.;Evaluate reminder
|
||
|
|
.D MAIN^PXRM(ORPT,ORIEN,1,1)
|
||
|
|
.;Not applicable is default
|
||
|
|
.S ORDUE=2 D Q:ORTXT=""
|
||
|
|
..S ORTXT="",ORTXT=$O(^TMP("PXRHM",$J,ORIEN,ORTXT)) Q:ORTXT=""
|
||
|
|
..;Determine status
|
||
|
|
..S ORX=^TMP("PXRHM",$J,ORIEN,ORTXT) Q:ORX=""
|
||
|
|
..S ORSTA=$P(ORX,U)
|
||
|
|
..;Ignore reminders that are not applicable
|
||
|
|
..I (ORSTA=" ")!(ORSTA["NEVER")!(ORSTA="N/A") Q
|
||
|
|
..;Differentiate due and applicable
|
||
|
|
..S ORDUE=0 I ORSTA["DUE" S ORDUE=1
|
||
|
|
..I ORSTA["ERROR" S ORDUE=3
|
||
|
|
..I ORSTA["CNBD" S ORDUE=4
|
||
|
|
..;Get next due and last done dates
|
||
|
|
..S ORDUEDT=$P(ORX,U,2),ORLASTDT=$P(ORX,U,3)
|
||
|
|
..S ORLASTDT=$S(+$G(ORLASTDT)>0:ORLASTDT,1:"") ;null if not a date
|
||
|
|
..;Reminder priority
|
||
|
|
..S ORPRI=$P($G(^PXD(811.9,ORIEN,0)),U,10)
|
||
|
|
..;Default is 2 for medium
|
||
|
|
..I ORPRI="" S ORPRI=2
|
||
|
|
..S ORJ=ORJ+1
|
||
|
|
..S ORY(ORJ)=ORIEN_U_ORTXT_U_ORDUEDT_U_ORLASTDT_U_ORPRI_U_ORDUE_U_$$DLG(ORIEN)_U_U_U_U_$$DLGWIPE(ORIEN)
|
||
|
|
.;Save not applicables also (IF a valid reminder)
|
||
|
|
.I ORDUE=2 D
|
||
|
|
..S ORJ=ORJ+1
|
||
|
|
..S ORY(ORJ)=ORIEN_U_ORTXT_U_U_U_U_ORDUE_U_$$DLG(ORIEN)_U_U_U_U_$$DLGWIPE(ORIEN)
|
||
|
|
K ^TMP("PXRHM",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CATEGORY(ORY,ORPT,ORLOC) ;Reminder Categories
|
||
|
|
;type^name^ien^parent^child^etc
|
||
|
|
N ERR,IC,ORSRV,PASS,TEMPLST
|
||
|
|
;Get user's service
|
||
|
|
;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
||
|
|
S ORSRV=$$GET1^DIQ(200,DUZ,29)
|
||
|
|
;Build list of locations and services required
|
||
|
|
I ORLOC S PASS="USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
I 'ORLOC S PASS="USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
;
|
||
|
|
;Get list of categories from GUI parameters file
|
||
|
|
D GETLST^XPAR(.TMPLST,PASS,"PXRM CPRS LOOKUP CATEGORIES","Q",.ERR)
|
||
|
|
;If error return error type
|
||
|
|
I ERR>0 S ORY(1)=U_"Error: "_$P(ERR,U,2) Q
|
||
|
|
;
|
||
|
|
;For each category build tree of reminders/subcategories
|
||
|
|
N CNT,LEVEL,ORCAT,UNIQ
|
||
|
|
S CNT="",IC=0,LEVEL=0,UNIQ=0
|
||
|
|
;For each category in 'PXRM CPRS LOOKUP CATEGORIES'
|
||
|
|
F S CNT=$O(TMPLST(CNT)) Q:'CNT D
|
||
|
|
.;Get category ien
|
||
|
|
.S ORCAT=$P(TMPLST(CNT),U,2)
|
||
|
|
.;Update unique number
|
||
|
|
.S UNIQ=UNIQ+1
|
||
|
|
.;Add category and associated reminders/subcategories to output array
|
||
|
|
.D GETLST(0,ORCAT,0,UNIQ)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DLG(REM) ;Dialog check
|
||
|
|
N DATA,DIEN,DOK
|
||
|
|
S DIEN=$P($G(^PXD(811.9,REM,51)),U) Q:'DIEN 0
|
||
|
|
S DATA=$G(^PXRMD(801.41,DIEN,0))
|
||
|
|
I $P(DATA,U,4)="R",$P(DATA,U,3)="" Q 1
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
DLGWIPE(REM) ;Dialog check
|
||
|
|
N DATA,DIEN,DOK
|
||
|
|
S DIEN=$P($G(^PXD(811.9,REM,51)),U) Q:'DIEN 0
|
||
|
|
I $P($G(^PXRMD(801.41,DIEN,0)),U,17)=1 Q 1
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
GETLST(D0,D1,LEVEL,PARENT) ;Add to output array
|
||
|
|
N DATA,NAME,ORREM,ORSCAT,PCAT,SEQ,SUB,TEMP,USAGE
|
||
|
|
;Get category ien if this is a sub-category
|
||
|
|
S PCAT=0 I LEVEL>0 D Q:ORSCAT="" S UNIQ=UNIQ+1,PARENT=UNIQ
|
||
|
|
.S ORSCAT=$P($G(^PXRMD(811.7,D0,10,D1,0)),U),PCAT=PARENT
|
||
|
|
;Otherwise use passed ien
|
||
|
|
I LEVEL=0 S ORSCAT=D1
|
||
|
|
;Get category name
|
||
|
|
S NAME=$G(^PXRMD(811.7,ORSCAT,0)) I NAME="" Q
|
||
|
|
;
|
||
|
|
;Create category entry in output array
|
||
|
|
;unique number^type^name^parent^reminder ien
|
||
|
|
;
|
||
|
|
S IC=IC+1,ORY(IC)=PARENT_U_"C"_U_NAME_U_PCAT_U
|
||
|
|
;Increment tab
|
||
|
|
S LEVEL=LEVEL+1
|
||
|
|
;
|
||
|
|
;Sort Reminders from this category into display sequence
|
||
|
|
S SUB=0 K TEMP
|
||
|
|
F S SUB=$O(^PXRMD(811.7,ORSCAT,2,SUB)) Q:SUB="" D
|
||
|
|
.S DATA=$G(^PXRMD(811.7,ORSCAT,2,SUB,0)) Q:DATA=""
|
||
|
|
.S ORREM=$P(DATA,U) Q:ORREM=""
|
||
|
|
.S SEQ=$P(DATA,U,2)_0
|
||
|
|
.;Skip inactive reminders
|
||
|
|
.S DATA=$G(^PXD(811.9,ORREM,0)) Q:DATA="" Q:$P(DATA,U,6)
|
||
|
|
.;Include only CPRS reminders
|
||
|
|
.S USAGE=$P($G(^PXD(811.9,ORREM,100)),U,4) I USAGE'["C",USAGE'["*" Q
|
||
|
|
.S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
|
||
|
|
.;or printname
|
||
|
|
.S NAME=$P(DATA,U,3)
|
||
|
|
.S TEMP(SEQ)=NAME_U_ORREM
|
||
|
|
;
|
||
|
|
;Re-save reminders in output array for display
|
||
|
|
;unique number^type^name^parent^reminder ien
|
||
|
|
;
|
||
|
|
S SEQ=""
|
||
|
|
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
|
||
|
|
.S NAME=$P(TEMP(SEQ),U),ORREM=$P(TEMP(SEQ),U,2)
|
||
|
|
.S UNIQ=UNIQ+1
|
||
|
|
.S IC=IC+1,ORY(IC)=UNIQ_U_"R"_U_NAME_U_PARENT_U_ORREM_U_$$DLG(ORREM)
|
||
|
|
;
|
||
|
|
;Sort Sub-Categories for this category into display order
|
||
|
|
S SUB=0 K TEMP
|
||
|
|
F S SUB=$O(^PXRMD(811.7,ORSCAT,10,SUB)) Q:SUB="" D
|
||
|
|
.S DATA=$G(^PXRMD(811.7,ORSCAT,10,SUB,0)) Q:DATA=""
|
||
|
|
.S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB
|
||
|
|
;
|
||
|
|
;Process sub-sub categories in the same manner
|
||
|
|
S SEQ=""
|
||
|
|
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
|
||
|
|
.S SUB=TEMP(SEQ)
|
||
|
|
.D GETLST(ORSCAT,SUB,LEVEL,PARENT)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
LIST(ORY,ORPT,ORLOC) ;Reminders for this patient location (not evaluated)
|
||
|
|
;format file 811.9 ien
|
||
|
|
N ORSRV,TMPLST,ERR,ORI,ORJ,ORIEN,ORTXT,ORX,ORLASTDT,ORDUEDT
|
||
|
|
N CNT,ORIEN,ORDUE,ORPRI,ORSTA,PASS,SUB
|
||
|
|
S ORJ=0
|
||
|
|
;
|
||
|
|
S ORSRV=$$GET1^DIQ(200,DUZ,29)
|
||
|
|
I ORLOC S PASS="USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
I 'ORLOC S PASS="USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG"
|
||
|
|
D GETLST^XPAR(.TMPLST,PASS,"ORQQPX SEARCH ITEMS","Q",.ERR) ; DBIA #3076
|
||
|
|
I ERR>0 S ORY(1)=U_"Error: "_$P(ERR,U,2) Q
|
||
|
|
;
|
||
|
|
S CNT=0,SUB=""
|
||
|
|
F S SUB=$O(TMPLST(SUB)) Q:'SUB D
|
||
|
|
.S ORIEN=$P(TMPLST(SUB),U,2) Q:'ORIEN Q:'$D(^PXD(811.9,ORIEN,0))
|
||
|
|
.S CNT=CNT+1,ORY(CNT)=ORIEN
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
REMDET(ORY,ORPT,ORIEN) ;return detail for a pt's clinical reminder
|
||
|
|
; ORY - return array
|
||
|
|
; ORPT - patient DFN
|
||
|
|
; ORIEN - clinical reminder (811.9 ien)
|
||
|
|
K ^TMP("PXRHM",$J)
|
||
|
|
D MAIN^PXRM(ORPT,ORIEN,5,1) ; 5 returns all reminder info
|
||
|
|
N CR,I,J,ORTXT,SCT,STA,STA1,STA2,STA3 S I=1,J=0
|
||
|
|
S ORTXT="",ORTXT=$O(^TMP("PXRHM",$J,ORIEN,ORTXT)) Q:ORTXT=""
|
||
|
|
S STA=$G(^TMP("PXRHM",$J,ORIEN,ORTXT)) I STA'="" D
|
||
|
|
.S STA(1)=$P(STA,U),STA(2)=$P(STA,U,2),STA(3)=$P(STA,U,3)
|
||
|
|
.F SCT=1,2,3 I STA(SCT) S STA(SCT)=$$FMTE^XLFDT(STA(SCT),"5D")
|
||
|
|
.S ORY(I)=" --STATUS-- --DUE DATE-- --LAST DONE--",I=I+1
|
||
|
|
.S ORY(I)=$J(STA(1),10)_$J(STA(2),13)_$J(STA(3),14),I=I+1
|
||
|
|
F S J=$O(^TMP("PXRHM",$J,ORIEN,ORTXT,"TXT",J)) Q:J="" D
|
||
|
|
.S ORY(I)=^TMP("PXRHM",$J,ORIEN,ORTXT,"TXT",J),I=I+1
|
||
|
|
K ^TMP("PXRHM",$J)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
WEB(ORY,ORRM) ;web page call
|
||
|
|
;web site description^address
|
||
|
|
N ADDR,CNT,DATA,DESC,LINE,SUB,TITLE,TXT,UNIQ
|
||
|
|
S DESC="",CNT=0,UNIQ=0
|
||
|
|
;Get the reminder specific web sites in alpha order
|
||
|
|
I ORRM]"" D
|
||
|
|
.F S DESC=$O(^PXD(811.9,ORRM,50,"B",DESC)) Q:DESC="" D
|
||
|
|
..S SUB=0
|
||
|
|
..F S SUB=$O(^PXD(811.9,ORRM,50,"B",DESC,SUB)) Q:'SUB D
|
||
|
|
...S ADDR=$P($G(^PXD(811.9,ORRM,50,SUB,0)),U) Q:ADDR=""
|
||
|
|
...S TITLE=$P($G(^PXD(811.9,ORRM,50,SUB,0)),U,2)
|
||
|
|
...S UNIQ=UNIQ+1,CNT=CNT+1,ORY(CNT)=1_U_UNIQ_U_ADDR_U_TITLE,LINE=0
|
||
|
|
...F S LINE=$O(^PXD(811.9,ORRM,50,SUB,1,LINE)) Q:'LINE D
|
||
|
|
....S TXT=$G(^PXD(811.9,ORRM,50,SUB,1,LINE,0)) Q:TXT=""
|
||
|
|
....S CNT=CNT+1,ORY(CNT)=2_U_UNIQ_U_TXT
|
||
|
|
;Get the general web sites in alpha order
|
||
|
|
F S DESC=$O(^PXRM(800,1,1,"B",DESC)) Q:DESC="" D
|
||
|
|
.S SUB=0
|
||
|
|
.F S SUB=$O(^PXRM(800,1,1,"B",DESC,SUB)) Q:'SUB D
|
||
|
|
..S ADDR=$P($G(^PXRM(800,1,1,SUB,0)),U) Q:ADDR=""
|
||
|
|
..S TITLE=$P($G(^PXRM(800,1,1,SUB,0)),U,2)
|
||
|
|
..S UNIQ=UNIQ+1,CNT=CNT+1,ORY(CNT)=1_U_UNIQ_U_ADDR_U_TITLE,LINE=0
|
||
|
|
..F S LINE=$O(^PXRM(800,1,1,SUB,1,LINE)) Q:'LINE D
|
||
|
|
...S TXT=$G(^PXRM(800,1,1,SUB,1,LINE,0)) Q:TXT=""
|
||
|
|
...S CNT=CNT+1,ORY(CNT)=2_U_UNIQ_U_TXT
|
||
|
|
Q
|