87 lines
3.7 KiB
Mathematica
87 lines
3.7 KiB
Mathematica
TIURPN ; SLC/JER - QUICK Review BY PATIENT ;2/28/01
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
|
|
EN(TIUCLASS,DFN) ; Entry point for build code
|
|
N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
|
|
N TIUDPRMT,TIUPICT,TIUOUT
|
|
K DIROUT
|
|
S TIUEDT=$$FMADD^XLFDT(DT,$S($D(^DPT(DFN,.1))'>0:-180,1:-30))
|
|
S TIULDT=+$$NOW^XLFDT
|
|
W !,"Searching for the documents."
|
|
D BUILD(TIUCLASS,DFN,TIUEDT,TIULDT)
|
|
Q
|
|
BUILD(CLASS,DFN,EARLY,LATE) ; Build List
|
|
N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUP,TIUQ,TIUDA,TIUREC
|
|
N TIUT,TIUTP,XREF,TIUS,TIUPREF,TIUPICK
|
|
S (TIUK,VALMCNT)=0
|
|
K ^TMP("TIUR",$J),^TMP("TIURIDX",$J)
|
|
S EARLY=9999999-+$G(EARLY),LATE=9999999-+$G(LATE)
|
|
S TIUJ=LATE
|
|
S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
|
|
F S TIUJ=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUJ)) Q:+TIUJ'>0!(+TIUJ>EARLY) D
|
|
. S TIUDA=0
|
|
. F S TIUDA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUJ,TIUDA)) Q:+TIUDA'>0 D
|
|
. . D ADDELMNT(TIUDA,.TIUCNT)
|
|
S ^TMP("TIUR",$J,0)=+$G(TIUCNT)_U_"ALL^APT^"_DFN
|
|
S ^TMP("TIUR",$J,0)=^TMP("TIUR",$J,0)_U_$P(^DPT(DFN,0),U)
|
|
S ^TMP("TIUR",$J,"CLASS")=TIUCLASS
|
|
S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+$G(TIUCNT)
|
|
I $D(VALMHDR)>9 D HDR^TIURH
|
|
S VALMCNT=+$G(TIUCNT)
|
|
I +$G(TIUCNT)'>0 D
|
|
. S ^TMP("TIUR",$J,1,0)="",VALMCNT=2
|
|
. S ^TMP("TIUR",$J,2,0)=" No records found to satisfy search criteria."
|
|
Q
|
|
ADDELMNT(DA,TIUCNT) ; Add each element to the list
|
|
N DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4
|
|
N TIUP,TIUREC,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,IDKIDFLG
|
|
I '$D(^TIU(8925,DA,0)) Q
|
|
I $G(^TMP("TIUR",$J,2,0))=" No records found to satisfy search criteria." D
|
|
. K ^TMP("TIUR",$J,2),^TMP("TIUR",$J,"IDX",2),^TMP("TIUR",$J,"IDX",1) S TIUCNT=0
|
|
S TIUD0=$G(^TIU(8925,+DA,0)),TIUD12=$G(^TIU(8925,+DA,12))
|
|
S TIUD13=$G(^TIU(8925,+DA,13)),TIUD15=$G(^TIU(8925,+DA,15))
|
|
I +TIUD0=81,(+$P(TIUD0,U,5)>5) Q
|
|
S DOC=$$PNAME^TIULC1(+TIUD0)
|
|
I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
|
|
S PT=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
|
|
S TIULI=$E(PT),IDKIDFLG=1
|
|
I +$O(^TIU(8925,"DAD",+DA,0)),$$HASADDEN^TIULC1(DA,IDKIDFLG) S PT="+ "_PT ;**100**
|
|
S TIUP=$$URGENCY(+DA)
|
|
S:TIUP=1 PT=$S(PT["+":"*",1:"* ")_PT
|
|
S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
|
|
S TIULST4="("_TIULI_TIULST4_")"
|
|
S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
|
|
S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY")
|
|
S AMD=$$PERSNAME^TIULC1($P(TIUD12,U,8)) S:AMD="UNKNOWN" AMD=""
|
|
S AUT=$$PERSNAME^TIULC1($P(TIUD12,U,2)) S:AUT="UNKNOWN" AUT=""
|
|
S AMD=$$NAME^TIULS(AMD,"LAST,FI MI")
|
|
S AUT=$$NAME^TIULS(AUT,"LAST,FI MI")
|
|
S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
|
|
S SDT=$S(+$P(TIUD15,U,7):+$P(TIUD15,U,7),+$P(TIUD0,U,5)'<7:+$P(TIUD15,U),1:"")
|
|
S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
|
|
S STATX=$P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U)
|
|
S TIUCNT=+$G(TIUCNT)+1
|
|
S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
|
|
S TIUREC=$$SETFLD^VALM1(PT,TIUREC,"PATIENT NAME")
|
|
S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
|
|
S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
|
|
S TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
|
|
S TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
|
|
S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(STATX),TIUREC,"STATUS")
|
|
S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
|
|
S TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER")
|
|
S ^TMP("TIUR",$J,TIUCNT,0)=TIUREC
|
|
S ^TMP("TIUR",$J,"IDX",TIUCNT,TIUCNT)="" W:TIUCNT#10'>0 "."
|
|
S ^TMP("TIURIDX",$J,TIUCNT)=TIUCNT_U_DA
|
|
S VALMCNT=TIUCNT
|
|
Q
|
|
CLEAN ; Clean up your mess!
|
|
K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10
|
|
K VALMY
|
|
Q
|
|
URGENCY(TIUDA) ; What is the urgency of the current document
|
|
N TIUY,TIUD0,TIUDSTAT,TIUDURG
|
|
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUDSTAT=$P(TIUD0,U,5)
|
|
S TIUDURG=$P(TIUD0,U,9)
|
|
S TIUY=$S(TIUDSTAT<7:$S(TIUDURG="P":1,1:2),1:3)
|
|
Q TIUY
|