176 lines
6.7 KiB
Mathematica
176 lines
6.7 KiB
Mathematica
TIURECL1 ; SLC/PKR,JER - Expand/collapse LM views ;5/8/03
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**100,113**;Jun 20, 1997
|
|
; 7/6 Split TIURECL into TIURECL & TIURECL1, move RESOLVE to TIURECL1
|
|
; 7/10 Move INSID, INSADD, VEXREQ, ISSUB to TIURECL1
|
|
; 9/7 Move INSKIDS, INSADD, & associated modules to TIURECL2
|
|
;=======================================================================
|
|
ISSUB(CLASS1,CLASS2,LEVEL) ;Return true if CLASS2 is sub to CLASS1.
|
|
N IND,ISSUB
|
|
I LEVEL(CLASS1)'<LEVEL(CLASS2) Q 0
|
|
;Check sublevel links between class1 and class2
|
|
S ISSUB=1
|
|
F IND=(CLASS1+1):1:(CLASS2-1) D
|
|
. I LEVEL(IND)=1 D Q
|
|
.. S ISSUB=0
|
|
Q ISSUB
|
|
;
|
|
;======================================================================
|
|
VEXREQ(VALMY) ;Check for valid expand/contract requests.
|
|
; A list of documents to expand/contract is invalid if any docmt
|
|
;is a sub docmt of another docmt on the list.
|
|
N END,START
|
|
S START=$O(VALMY(""))
|
|
S END=$O(VALMY(""),-1)
|
|
I START=END Q 1
|
|
;
|
|
N ACTION,ACTIND,ACTJND,CIND,CN,IND,JND,LEVEL,MSG,TEXT,VALID
|
|
;Build the level list.
|
|
F IND=START:1:END D
|
|
. S LEVEL(IND)=$L(@VALMAR@(IND,0),"|")
|
|
S VALID=1
|
|
S IND=""
|
|
F S IND=$O(VALMY(IND)) Q:+IND'>0 D
|
|
. S TEXT(IND)=$G(@VALMAR@(IND,0))
|
|
. S ACTIND=$S(TEXT(IND)["+":"+ ",TEXT(IND)["-":"-",1:"")
|
|
. I ACTIND="" Q
|
|
. S ACTION(IND)=$S(TEXT(IND)["+":"expand ",TEXT(IND)["-":"collapse ",1:"")
|
|
. S JND=IND
|
|
. F S JND=$O(VALMY(JND)) Q:+JND'>0 D
|
|
.. S TEXT(JND)=$G(@VALMAR@(JND,0))
|
|
.. S ACTJND=$S(TEXT(JND)["+":"+",TEXT(JND)["-":"-",1:"")
|
|
.. I ACTJND="" Q
|
|
.. S ACTION(JND)=$S(TEXT(JND)["+":"expand ",TEXT(JND)["-":"collapse ",1:"")
|
|
.. I $$ISSUB(IND,JND,.LEVEL) D
|
|
... I ACTION(IND)'=ACTION(JND) D Q
|
|
.... S CIND(IND)=$P(^TMP("TIURIDX",$J,IND),U,2)
|
|
.... S CN(IND)=$P(^TIU(8925,CIND(IND),0),U,1)
|
|
.... S CIND(JND)=$P(^TMP("TIURIDX",$J,JND),U,2)
|
|
.... S CN(JND)=$P(^TIU(8925,CIND(JND),0),U,1)
|
|
.... I '+$G(HUSH) D
|
|
..... S MSG="You cannot "_ACTION(IND)_CN(IND)_" and "_ACTION(JND)_CN(JND)
|
|
..... D MSG^VALM10(MSG)
|
|
..... H 4
|
|
.... S VALID=0
|
|
Q VALID
|
|
;======================================================================
|
|
IDDATA(TIUDA,TIUD0,TIUD21) ; Return TIUGDATA:
|
|
; TIUGDATA = 0 or
|
|
; = TIUDA^haskid^IDparent^prmsort, where
|
|
; TIUDA = note DA
|
|
; haskid = 1 if note has ID kid, else 0
|
|
; IDparent = parent DA if note has ID parent, else 0
|
|
; prmsort = 'TITLE' if entries ordered by title, else 'REFDT'
|
|
;Note: TIUGDATA is nonzero if note is POSSIBLE DAD, or dad, or kid.
|
|
; Requires TIUDA; TIUD0 & TIUD21 are optional
|
|
N HASIDKID,POSSPRNT,TIUDPRM,PRMSORT,TIUGDATA
|
|
I '$G(TIUD0) S TIUD0=^TIU(8925,TIUDA,0)
|
|
I '$D(TIUD21) S TIUD21=+$G(^TIU(8925,TIUDA,21))
|
|
S (TIUGDATA,POSSPRNT)=0
|
|
S HASIDKID=$$HASIDKID^TIUGBR(TIUDA)
|
|
I 'TIUD21,'HASIDKID S POSSPRNT=$$POSSPRNT^TIULP(+TIUD0) ;has bus rules
|
|
I TIUD21!HASIDKID!POSSPRNT D
|
|
. I 'TIUD21 D I 1
|
|
. . D DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
|
|
. . S PRMSORT=$S($P($G(TIUDPRM(0)),U,18):"TITLE",1:"REFDT")
|
|
. E S PRMSORT=""
|
|
. S TIUGDATA=TIUDA_U_HASIDKID_U_TIUD21_U_PRMSORT
|
|
Q TIUGDATA
|
|
;
|
|
RESOLVE(DA,TSTART,FIRSTPFX,XIDDATA) ; Get document data for insertion
|
|
; Receives DA, TSTART, FIRSTPFX
|
|
; FIRSTPFX = $$INSPFIX of parent of inserted document.
|
|
; Returns line TSTART.
|
|
; Receives XIDDATA by ref, finds it, and passes it back.
|
|
N DIC,DIQ,DR,TIUR,PT,MOM,ADT,DDT,LCT,AUT,AMD,EDT,SDT,XDT,RMD,TIULST4
|
|
N TIUP,TIUD0,TIUD12,TIUD13,TIUD15,TIULI,STATX,DOC,TIUY,TIUI,TIUFLDS
|
|
N PREFIX,GETTL,GETPT,TIUD21,INSTA,TIUSTN
|
|
I '$D(^TIU(8925,DA,0)) S TIUY="Record #"_DA_" is missing." G RESOLVEX
|
|
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))
|
|
S TIUD21=$G(^TIU(8925,+DA,21))
|
|
S XIDDATA=$$IDDATA(DA,TIUD0,TIUD21)
|
|
S PREFIX=$$PREFIX^TIULA2(DA),PREFIX=FIRSTPFX_PREFIX
|
|
S GETTL=$$GETTL(TIUD0,PREFIX)
|
|
; Most screens have docmt title in 1st column, but some have pat nm:
|
|
S DOC=$S($D(VALMDDF("PATIENT NAME")):$P(GETTL,U),1:$P(GETTL,U,2)_$P(GETTL,U))
|
|
S TIUFLDS("DOCUMENT TYPE")="DOC"
|
|
S TIUFLDS("TITLE")="DOC"
|
|
S GETPT=$$GETPT(TIUD0,PREFIX)
|
|
S TIULI=$E(GETPT)
|
|
S PT=$P(GETPT,U,2)_$P(GETPT,U)
|
|
S TIUFLDS("PATIENT NAME")="PT"
|
|
S TIULST4=$E($P($G(^DPT(+$P(TIUD0,U,2),0)),U,9),6,9)
|
|
S TIULST4="("_TIULI_TIULST4_")"
|
|
S TIUFLDS("LAST I/LAST 4")="TIULST4"
|
|
S ADT=$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/YY")
|
|
S TIUFLDS("ADMISSION DATE")="ADT"
|
|
S DDT=$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/YY"),LCT=$P(TIUD0,U,10)
|
|
S TIUFLDS("DISCH DATE")="DDT"
|
|
S TIUFLDS("LINE COUNT")="AMD"
|
|
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 TIUFLDS("ATTENDING")="AMD"
|
|
S TIUFLDS("COSIGNER")="AMD"
|
|
I $D(^TMP("TIUR",$J,"CTXT")) S AUT=$$NAME^TIULS(AUT,"LAST,FI") I 1
|
|
E S AUT=$$NAME^TIULS(AUT,"LAST, FI MI")
|
|
S TIUFLDS("AUTHOR")="AUT"
|
|
I $D(^TMP("TIUR",$J,"CTXT")) S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY HR:MIN") I 1
|
|
E S EDT=$$DATE^TIULS($P(TIUD13,U),"MM/DD/YY")
|
|
S TIUFLDS("REF DATE")="EDT"
|
|
S XDT=$$DATE^TIULS($P(TIUD13,U,7),"MM/DD/YY")
|
|
S TIUFLDS("DICT DATE")="XDT"
|
|
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 TIUFLDS("SIG DATE")="SDT"
|
|
S STATX=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
|
|
S TIUFLDS("STATUS")="STATX"
|
|
S INSTA=""
|
|
I +$P(TIUD12,U,12)>0 D
|
|
. S TIUSTN=$$NS^XUAF4($P(TIUD12,U,12))
|
|
. I $P(TIUSTN,U,2)]"" S INSTA=$P(TIUSTN,U,2)
|
|
S INSTA=$E(INSTA,1,8)
|
|
S TIUFLDS("DIVISION")="INSTA"
|
|
S (TIUI,TIUY)=""
|
|
S TIUY=$$SETFLD^VALM1(TSTART,TIUY,"NUMBER")
|
|
F S TIUI=$O(TIUFLDS(TIUI)) Q:TIUI="" D
|
|
. S:$D(VALMDDF(TIUI)) TIUY=$$SETFLD^VALM1(@TIUFLDS(TIUI),TIUY,TIUI)
|
|
RESOLVEX Q TIUY
|
|
;
|
|
GETPT(TIUD0,PREFIX) ; Get patient column data; put updated prefix data
|
|
;in second ^ piece
|
|
; Receives TIUDO, PREFIX.
|
|
; Returns (patient col data)^PREFIX
|
|
N TIUY
|
|
S TIUY=$$NAME^TIULS($$PTNAME^TIULC1($P(TIUD0,U,2)),"LAST,FI MI")
|
|
I $D(PREFIX) S TIUY=TIUY_U_PREFIX
|
|
Q TIUY
|
|
;
|
|
GETTL(TIUD0,PREFIX) ; Get title column data; put updated prefix
|
|
;data in second ^ piece.
|
|
; Receives TIUDO, PREFIX.
|
|
; Returns (title col data)^PREFIX
|
|
N TIUY
|
|
S TIUY=$$PNAME^TIULC1(+TIUD0)
|
|
I TIUY="Addendum" S TIUY="Addendum to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
|
|
I $D(PREFIX) S TIUY=TIUY_U_PREFIX
|
|
Q TIUY
|
|
;
|
|
SETTLPT(STRING,DA,PREFIX) ; Set field TITLE or PATIENT into string,
|
|
;with prefix as first chars of string.
|
|
; Receives STRING, DA, PREFIX:
|
|
; PREFIX = beginning chars of title/pt column, up to but not
|
|
; including title/pt itself.
|
|
; Returns STRING.
|
|
N PT,DOC,TIUD0
|
|
S TIUD0=^TIU(8925,DA,0)
|
|
I $D(VALMDDF("PATIENT NAME")) D I 1
|
|
. S PT=$$GETPT(TIUD0,PREFIX)
|
|
. S PT=$P(PT,U,2)_$P(PT,U)
|
|
. S STRING=$$SETFLD^VALM1(PT,STRING,"PATIENT NAME")
|
|
E D
|
|
. S DOC=$$GETTL(TIUD0,PREFIX)
|
|
. S DOC=$P(DOC,U,2)_$P(DOC,U)
|
|
. S STRING=$$SETFLD^VALM1(DOC,STRING,"TITLE")
|
|
Q STRING
|