170 lines
8.5 KiB
Mathematica
170 lines
8.5 KiB
Mathematica
TIUROR ;SLC/JER - New PATIENT Review screen ; 9/5/01
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**10,86,88,100,123,143**;Jun 20, 1997
|
|
; Split rtn into TIUROR & TIUROR1 11/27/00
|
|
EN ; -- main entry point for TIU OE/RR REVIEW PN
|
|
D EN^VALM("TIU OE/RR REVIEW PN")
|
|
Q
|
|
;
|
|
HDR ; -- header code
|
|
N TIUCTXT,TIUPNM,TIUSSN,TIULOC,TIUDOB,TIUHDR,TIUCWAD,TIUDCNT,VADM,VA
|
|
N TIUDFN I +$D(@VALMAR@(0))'>0 S VALMQUIT=1 Q
|
|
S TIUDFN=+$G(@VALMAR@("DFN"))
|
|
S TIUCWAD=$$CWAD^GMRPNOR1(TIUDFN) S:TIUCWAD]"" TIUCWAD="<"_TIUCWAD_">"
|
|
S TIUDCNT=$J($S($G(@VALMAR@("CTXT"))="INIT":"Last ",1:"")_+@VALMAR@(0)_" note(s)",16)
|
|
S TIUCTXT=$$UP^XLFSTR($$PNAME^TIULC1(@VALMAR@("CLASS")))
|
|
S TIUCTXT=$$TITLE^TIUU(TIUCTXT)
|
|
S TIUHDR=$$SETSTR^VALM1(TIUCWAD,$G(TIUHDR),1,20)
|
|
S TIUHDR=$$SETSTR^VALM1(TIUCTXT,$G(TIUHDR),27,28)
|
|
S TIUHDR=$$SETSTR^VALM1(TIUDCNT,$G(TIUHDR),64,16)
|
|
S VALMHDR(1)=TIUHDR,TIUHDR=""
|
|
S TIUPNM=$$NAME^TIULO(TIUDFN),TIUSSN=$$SSN^TIULO(TIUDFN)
|
|
S TIUDOB=$$DOB^TIULO(TIUDFN)_" ("_$$AGE^TIULO(TIUDFN)_")"
|
|
S TIULOC=$G(^DPT(+TIUDFN,.1))
|
|
S:TIULOC]"" TIULOC=TIULOC_"/"_$G(^DPT(+TIUDFN,.101))
|
|
S TIUHDR=$$SETSTR^VALM1(TIUPNM,$G(TIUHDR),1,20)
|
|
S TIUHDR=$$SETSTR^VALM1(TIUSSN,$G(TIUHDR),22,11)
|
|
S TIUHDR=$$SETSTR^VALM1(TIULOC,$G(TIUHDR),35,20)
|
|
S TIUHDR=$$SETSTR^VALM1(TIUDOB,$G(TIUHDR),64,16)
|
|
S VALMHDR(2)=TIUHDR
|
|
Q
|
|
;
|
|
INIT(CLASS,CONTEXT,DFN,TIUOCC) ; -- init variables and list array
|
|
N TIUR,TIUI,TIUY,TIUPICK,TIUQUIT,TIUCCTXT,TIUDUZ,TIUERLY,TIULATE
|
|
N TIUPREF,TIUOCTXT,TIURCTXT,TIUSEQ,TIUDPRM
|
|
N DUOUT,DTOUT,DIROUT ;1/8/01
|
|
I $G(@VALMAR@("SEQ"))]"" S TIUSEQ=$G(@VALMAR@("SEQ"))
|
|
I +$G(@VALMAR@("CTXT")) S TIURCTXT=$G(@VALMAR@("CTXT"))
|
|
K @VALMAR,VALMCNT,^TMP("TIURIDX",$J)
|
|
K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
|
|
S TIUPREF=$$PERSPRF^TIULE(DUZ)
|
|
S TIUSEQ=$G(TIUSEQ,$S($P(TIUPREF,U,4)="A":"A",1:"D"))
|
|
S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
|
|
S DFN=$S(+$G(DFN):+$G(DFN),+$G(ORVP):+$G(ORVP),1:+$$PATIENT^TIULA)
|
|
I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(DFN)'>0:1,1:0) S VALMQUIT=1 Q
|
|
I +$G(CONTEXT)'=9999,'+$G(TIUOCC) S TIUOCC=$S(+$P(TIUPREF,U,10):+$P(TIUPREF,U,10),1:100)
|
|
S ^TMP("TIUR",$J,"RTN")="TIUROR"
|
|
I '$O(^TIU(8925,"ACLPT",CLASS,DFN,0)),'$O(^TIU(8925,"ACLAU",CLASS,DUZ,DFN,0)),'$O(^TIU(8925,"ACLEC",CLASS,DUZ,DFN,0)) D Q:$G(CONTEXT)'=9999
|
|
. N TIUST
|
|
. S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
|
|
. S VALMCNT=2,^TMP("TIUR",$J,0)=0
|
|
. S ^TMP("TIUR",$J,1,0)=""
|
|
. S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
|
|
. S TIUOCTXT=CONTEXT
|
|
. I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
|
|
. I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
|
|
. S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
|
|
. S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("CTXT")=TIUOCTXT D HDR
|
|
I $G(CONTEXT)=9999 S TIUCCTXT=1,TIUOCC=9999999
|
|
; -- Set vars needed for RBLD if user ^s:
|
|
S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("OCC")=TIUOCC,^("CTXT")=+$G(TIURCTXT)
|
|
S CONTEXT=$S($G(CONTEXT)=9999:$$ASKCTXT^TIUROR1,+$G(CONTEXT):+$G(CONTEXT),1:1)
|
|
; -- 1=Signed 2=Unsigned 3=Uncosigned 4=Signed/Author 5=Signed/Date --
|
|
I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) D RBLD Q
|
|
I $S(CONTEXT=1:1,CONTEXT=2:1,CONTEXT=3:1,1:0) S TIUERLY="",TIULATE="",TIUDUZ=DUZ
|
|
I CONTEXT=4 D Q:+$G(TIUQUIT)>0
|
|
. S TIUERLY="",TIULATE=""
|
|
. S TIUDUZ=$S(+$G(TIURCTXT)'=4:+$$AUTHOR^TIULA2(1),+$P(TIURCTXT,U,2)'>0:+$$AUTHOR^TIULA2(1),+$G(TIUCCTXT):+$$AUTHOR^TIULA2(1),1:+$P(TIURCTXT,U,2))
|
|
. I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(TIUDUZ)'>0:1,1:0) S TIUQUIT=1 D RBLD Q ; changed DIRUT to DTOUT. 10/20/00
|
|
. S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
|
|
. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
|
|
I CONTEXT=5 D Q:+$G(TIUQUIT)>0
|
|
. S TIUDUZ=+$G(DUZ)
|
|
. S TIUERLY=$S(+$G(TIURCTXT)'=5:$$EDATE^TIULA("",7,""),+$P(TIURCTXT,U,2)'>0:$$EDATE^TIULA("",7,""),+$G(TIUCCTXT):$$EDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,2))
|
|
. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
|
|
. S TIUERLY=$P(TIUERLY,U)
|
|
. S TIULATE=$S(+$G(TIURCTXT)'=5:$$LDATE^TIULA("",7,""),+$P(TIURCTXT,U,3)'>0:$$LDATE^TIULA("",7,""),+$G(TIUCCTXT):$$LDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,3))
|
|
. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
|
|
. S TIULATE=$P(TIULATE,U)
|
|
. I TIUERLY>TIULATE D SWAP^TIUR(.TIUERLY,.TIULATE)
|
|
. I $L(TIULATE,".")=1 D EXPRANGE^TIUR(.TIUERLY,.TIULATE)
|
|
. S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
|
|
. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
|
|
I '$G(TIURBLD) W !,"Searching for the progress notes"
|
|
N TIUEXPKD
|
|
D CONTEXT^TIUSRVLL(.TIUY,CLASS,CONTEXT,DFN,TIUERLY,TIULATE,TIUDUZ,TIUOCC,TIUSEQ,.TIUEXPKD) W "."
|
|
; I $D(TIUY)'>9 D Q ; original code
|
|
I $D(^TMP("TIUYARRAY",$J))'>9 D Q ; TIU*1.0*143
|
|
. N TIUST
|
|
. S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
|
|
. S VALMCNT=2,^TMP("TIUR",$J,0)=0
|
|
. S ^TMP("TIUR",$J,1,0)=""
|
|
. S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
|
|
. S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN
|
|
. S TIUOCTXT=CONTEXT
|
|
. I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
|
|
. I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
|
|
. S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
|
|
. S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT):"INIT",1:TIUOCTXT) D HDR
|
|
S TIUI=""
|
|
; F S TIUI=$O(TIUY(TIUI)) Q:TIUI="" D ; original code
|
|
F S TIUI=$O(^TMP("TIUYARRAY",$J,TIUI)) Q:TIUI="" D ; TIU*1.0*143
|
|
. N AUT,RDT,STAT,TITL,TIUD0,TIUD12,TIUD13,PREFIX
|
|
. N TIUGDATA
|
|
. S TIUD0=$G(^TIU(8925,+^TMP("TIUYARRAY",$J,TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; **
|
|
. ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; original
|
|
. S VALMCNT=+$G(VALMCNT)+1 W:(VALMCNT#100'>0) "."
|
|
. S TITL=$$PNAME^TIULC1(+TIUD0)
|
|
. I TITL="Addendum" S TITL=TITL_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
|
|
. ; -- Mark ID note '<' and/or has addendum '+',
|
|
. S PREFIX=$$PREFIX^TIULA2(+^TMP("TIUYARRAY",$J,TIUI),0) ; TIU*1.0*143
|
|
. ; S PREFIX=$$PREFIX^TIULA2(+TIUY(TIUI),0) ; original
|
|
. S TITL=PREFIX_TITL
|
|
. S AUT=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI")
|
|
. S RDT=$$DATE^TIULS(+TIUD13,"MM/DD/YY HR:MIN")
|
|
. S STAT=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
|
|
. S TIUR=$$SETFLD^VALM1(VALMCNT,$G(TIUR),"NUMBER")
|
|
. S TIUR=$$SETFLD^VALM1(TITL,$G(TIUR),"TITLE")
|
|
. S TIUR=$$SETFLD^VALM1(AUT,$G(TIUR),"AUTHOR")
|
|
. S TIUR=$$SETFLD^VALM1(RDT,$G(TIUR),"REF DATE")
|
|
. S TIUR=$$SETFLD^VALM1(STAT,$G(TIUR),"STATUS")
|
|
. S ^TMP("TIUR",$J,VALMCNT,0)=TIUR
|
|
. S ^TMP("TIUR",$J,0)=VALMCNT
|
|
. S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+^TMP("TIUYARRAY",$J,TIUI)_U_PREFIX ; TIU*1.0*143
|
|
. ; S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+TIUY(TIUI)_U_PREFIX ; original
|
|
. S ^TMP("TIUR",$J,"IEN",+^TMP("TIUYARRAY",$J,TIUI),VALMCNT)="" ; TIU*1.0*143
|
|
. ; S ^TMP("TIUR",$J,"IEN",+TIUY(TIUI),VALMCNT)="" ;original
|
|
. S ^TMP("TIUR",$J,"IDX",VALMCNT,VALMCNT)=""
|
|
. ; TIUGDATA = 0 or DA^haskid^IDparent^prmsort:
|
|
. S TIUGDATA=$$IDDATA^TIURECL1(+^TMP("TIUYARRAY",$J,TIUI),TIUD0) ; TIU*1.0*143
|
|
. ; S TIUGDATA=$$IDDATA^TIURECL1(+TIUY(TIUI),TIUD0) ; original
|
|
. I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+^TMP("TIUYARRAY",$J,TIUI))=TIUGDATA ; TIU*1.0*143
|
|
. ; I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+TIUY(TIUI))=TIUGDATA ; original
|
|
S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+VALMCNT
|
|
S ^TMP("TIUR",$J,"CLASS")=CLASS
|
|
S ^TMP("TIUR",$J,"DFN")=DFN
|
|
S ^TMP("TIUR",$J,"OCC")=+$G(TIUOCC)
|
|
S TIUOCTXT=CONTEXT
|
|
I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
|
|
I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
|
|
S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
|
|
S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT)&(VALMCNT'<TIUOCC):"INIT",1:TIUOCTXT)
|
|
I CONTEXT=1,(+$G(TIUOCC)=9999999) D SAVE^TIUROR1
|
|
I +$G(TIUCCTXT),$D(^TMP("TIUR",$J,0)) D HDR
|
|
; If first build (not rebuild), expand parents to show kids that
|
|
;meet criteria:
|
|
I '$G(TIURBLD),$D(TIUEXPKD) D
|
|
. D EXPANDKD^TIUR2(.TIUEXPKD,"",CONTEXT)
|
|
; K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
|
|
Q
|
|
;
|
|
EXIT ; -- exit code
|
|
D CLEAN^VALM10
|
|
K DFN,VALMY,VALMCNT,VALMKEY,^TMP("TIURSAVE",$J)
|
|
K ^TMP("TIURIDX",$J)
|
|
K TIUGLINK ;**100**
|
|
Q
|
|
;
|
|
RBLD ; -- rebuild list after actions
|
|
N TIUEXP,TIURBLD
|
|
S TIURBLD=1
|
|
I +$O(^TMP("TIUR",$J,"EXPAND",0)) D G RBLDX
|
|
. M TIUEXP=^TMP("TIUR",$J,"EXPAND")
|
|
. D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
|
|
. D RELOAD^TIUROR1(.TIUEXP)
|
|
. D BREATHE^TIUROR1(1)
|
|
D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
|
|
;D HDR S VALMBCK="R",VALMBG=1,VALMCNT=+$G(^TMP("TIUR",$J,0))
|
|
D HDR S VALMBCK="R",VALMCNT=+$G(^TMP("TIUR",$J,0))
|
|
RBLDX I $G(VALMBG)>$G(VALMCNT) S VALMBG=$G(VALMCNT)
|
|
Q
|