TIULA2 ; SLC/JER - More interactive functions ;10/19/06 14:32
;;1.0;TEXT INTEGRATION UTILITIES;**1,50,86,93,61,100,116,143,211**;Jun 20, 1997;Build 26
ASKTYP(TIUCLASS,DFLT,SCREEN,PROMPT,NOLOINC) ; Call ^DIC to select single type
N D,DIC,X,Y,TIUFPRIV,ITMCNT S TIUFPRIV=1
S DIC=8925.1,TIUCLASS=$G(TIUCLASS,38),ITMCNT=$$ITMCNT(TIUCLASS)
I +ITMCNT=1 D G ASKTYPX
. I $P($G(^TIU(8925.1,+TIUCLASS,0)),U,4)="CL" D Q
. . S TIUCLASS=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
. . S Y=$$ASKTYP(+TIUCLASS,DFLT,SCREEN,$G(PROMPT))
. S DIC(0)="NX",X=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
. D ^DIC S Y=Y_U_"SINGLE ITEM"
S DIC(0)="AEMQZOV"
S DIC("A")=$S($G(PROMPT)]"":$G(PROMPT),1:"Select TITLE: ")
I $G(DFLT)="LAST" S DFLT=$P($$PERSDOC^TIULE(DUZ,+$G(TIUCLASS,38)),U,2)
I +$G(DFLT),+$D(TIUCLASS),(+$$ISA^TIULX(+$G(DFLT),+$G(TIUCLASS))'>0) S DFLT=""
I $G(DFLT)]"" S DIC("B")=$G(DFLT)
I $G(SCREEN)]"" S DIC("S")=SCREEN
S D="B^C^D^E"_$S(+$G(NOLOINC):"",1:"^LOINC")
D MIX^DIC1 K DIC("S")
ASKTYPX Q Y
ITMCNT(CLASS) ; Count the number of members of a class or document class
N TIUI,TIUCNT,TIUY S (TIUI,TIUCNT,TIUY)=0
F S TIUI=$O(^TIU(8925.1,+CLASS,10,TIUI)) Q:+TIUI'>0 D
. I +$$CANPICK^TIULP(+$G(^TIU(8925.1,+CLASS,10,TIUI,0))) D
. . S TIUCNT=TIUCNT+1
. . S TIUY=TIUCNT_U_TIUI
Q TIUY
DOCPICK(TIUCLASS,DFLT,ADDSCRN) ; Ask for document, given a class or document class
N SCREEN,PROMPT S PROMPT=$S(TIUCLASS=3:"TITLE: ",1:"")
S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,TIUCLASS),+$$CANPICK^TIULP(+Y)"_$S($G(ADDSCRN)]"":",",1:"")_$G(ADDSCRN)
Q $$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
DOCSPICK(TIUY,TIUCLASS,PARM,DFLT,PROMPT,ADDSCRN) ; Ask for TITLE(S)
; with pick-list
N SCREEN,Y,ATTCHID
S DFLT=$S($G(DFLT)=0:"",$G(DFLT)]"":$G(DFLT),1:"LAST")
S PARM=$S($G(PARM)]"":PARM,1:"A")
; D DOCLIST^TIULA1(TIUCLASS,.TIUY,PARM,DFLT) I +TIUY>0 Q
; ADD CALL TO PERSONAL DOCUMENT LISTER HERE
S ATTCHID=0 I $G(ADDSCRN)["CANLINK^TIULP" S ATTCHID=1
I PARM="1A" D TITLPICK^TIULA4(.TIUY,TIUCLASS,ATTCHID) I +$G(TIUY)>0 Q
S PROMPT=$S($G(PROMPT)]"":$G(PROMPT),TIUCLASS=3:"TITLE: ",1:"")
S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,TIUCLASS)"_$S($G(ADDSCRN)]"":",",1:"")_$G(ADDSCRN)
I $G(TIUY("NODFLT")) S DFLT="" ; User selected "Other title"
S TIUY=$$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
I +TIUY>0 S TIUY(1)=1_U_TIUY,TIUY=1
Q
SELPAT(TIURTN,TIUTYP,DFN,TIUASK) ; Select a patient's document
N TIUI,TIUQRY,TIUREC,TIUEDT,TIULDT,TIUPRMT,TIUA,TIUZ,TIUTOT,TIUSTOP
N TIULAST,TIULIST,TIUJ,TIUY,TIUPNOUN,TIUSMPL,TIUTMP,TIUEDFLT,TIUCONT
K ^TMP("TIULIST",$J),^TMP("TIULIDX",$J)
K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
S TIUTYP=$G(TIUTYP,38)
S TIUPNOUN=$S(TIUTYP=3:"notes",TIUTYP=244:"summaries",1:"documents")
I '+$G(DFN) S DFN=+$$PATIENT^TIULA Q:+DFN'>0
I +$O(^TIU(8925,"APTCL",+DFN,+TIUTYP,0))'>0 D Q
. W !!,"No ",TIUPNOUN," on file for ",$P(^DPT(+DFN,0),U)
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
S TIUSMPL=$$SAMPLE(DFN,TIUTYP)
I +TIUSMPL'>0 D Q
. W !!,"No ",TIUPNOUN," available for ",$P(^DPT(+DFN,0),U),!
. I $$READ^TIUU("EA","Press RETURN to continue...") W ""
S TIUTOT=+$P(TIUSMPL,U)
S TIUEDT=+$P(TIUSMPL,U,2)_U_$$DATE^TIULS(+$P(TIUSMPL,U,2),"MM/DD/CCYY")
S TIULDT=+$P(TIUSMPL,U,3)_U_$$DATE^TIULS(+$P(TIUSMPL,U,3),"MM/DD/CCYY")
W !!,"Available ",TIUPNOUN,": ",$P(TIUEDT,U,2)
W " thru ",$P(TIULDT,U,2)," (",TIUTOT,")"
I +$G(TIUASK)>0 D Q:+$G(TIUCONT)'>0
. N TIUPRMT S TIUPRMT="Do you wish to see any of these notes"
. S TIUCONT=+$$READ^TIUU("YO",TIUPRMT,"NO")
I +TIUTOT=1,+$P(TIUSMPL,U,4) S TIURTN=1,TIURTN(1)=+$P(TIUSMPL,U,4) Q
W !!,"Please specify a date range from which to select ",TIUPNOUN_":"
S TIUPRMT="List "_TIUPNOUN_" Beginning: "
S TIUEDFLT=$P(TIUEDT,U)
I +TIUEDFLT<+$P(TIUEDT,U) S TIUEDFLT=$P(TIUEDT,U,2)
I TIUEDFLT'["/" S TIUEDFLT=$$DATE^TIULS(TIUEDFLT,"MM/DD/CCYY")
S TIUA=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,TIUEDFLT)
I +$D(DIRUT)!(TIUA'>0) Q
S TIUPRMT=$J("Thru: ",$L(TIUPRMT))
S TIUZ=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,$P(TIULDT,U,2))_".2401" W !
I +$D(DIRUT)!(TIUA'>0) Q
I +TIUA>TIUZ S TIUTMP=TIUA,TIUA=TIUZ,TIUZ=TIUTMP
; ZDEBUG ON B 1
D LIST^TIUSRVLL(.TIUY,TIUTYP,DFN,TIUA,TIUZ)
I $D(^TMP("TIUYLIST",$J))>9 D ; I $D(TIUY)>9 - modified TIU*1.0*143
. ; S TIUI=0 F S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0) D ; - modified TIU*1.0*143
. S TIUI=0 F S TIUI=$O(^TMP("TIUYLIST",$J,TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0) D
. . N TIUD0,TIUD13,TIUD12,TIUD17,TIUDOC,PREFIX
. . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)) ; - modified TIU*1.0*143
. . S TIUD0=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),0)),TIUD12=$G(^(12))
. . ; S TIUD13=$G(^TIU(8925,+TIUY(TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI ; - modified TIU*1.0*143
. . S TIUD13=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI
. . S TIUDOC=$E($$PNAME^TIULC1(+TIUD0),1,36)
. . I TIUDOC="Addendum" S TIUDOC=TIUDOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
. . ; S PREFIX=$$PREFIX(+TIUY(TIUI),1),TIUDOC=PREFIX_TIUDOC ; - modified TIU*1.0*143
. . S PREFIX=$$PREFIX(+^TMP("TIUYLIST",$J,TIUI),1),TIUDOC=PREFIX_TIUDOC
. . I +$P(TIUD0,U,5)=15 S TIUDOC=TIUDOC_" (RETRACTED)"
. . W !,TIUI,?4,$$DATE^TIULS(+TIUD13,"MM/DD/CCYY HR:MIN")
. . W ?22,TIUDOC
. . W ?60,$E($$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI"),1,19)
. . W !?$S($P(TIUD0,U,13)="H":24,1:22),$S($P(TIUD0,U,13)="H":"Adm: ",1:"Visit: "),$$DATE^TIULS($P(TIUD0,U,7),"MM/DD/CCYY")
. . I $P(TIUD0,U,13)="H" W ?41,"Dis: ",$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/CCYY")
. . I $L(TIUD17) W !,"SUBJECT: ",$E(TIUD17,1,70)
. . I '(TIUI#5),(TIUI<+$P(TIUY,U)) D CHOOSE(.TIUSTOP," '^' TO STOP: ",1,TIUI,1)
. ; I +TIUY=1 S TIURTN(1)=+TIUY(1) D Q ; - modified TIU*1.0*143
. I +TIUY=1 S TIURTN(1)=+^TMP("TIUYLIST",$J,1) D Q
. . W !!,"One ",$S(TIUTYP=3:"note",TIUTYP=244:"summary",1:"document")
. . W " found within date range..." H 1
. I +$G(TIUSTOP)>0,(+$G(TIUSTOP)'=9999999) M TIULIST=TIUSTOP
. E D CHOOSE(.TIULIST,"Choose one or more "_TIUPNOUN_": (1-"_+$G(TIULAST)_"): ",1,+$G(TIULAST))
. N TIUK
. S TIUK="",TIURTN=0
. F S TIUK=$O(TIULIST(TIUK)) Q:TIUK="" D
. . F TIUI=1:1:$L(TIULIST(TIUK),",") D
. . . S TIUJ=$P(TIULIST,",",TIUI)
. . . ; I +TIUJ>0,+$G(^TIU(8925,+$G(TIUY(+TIUJ)),0)) S TIURTN(TIUI)=+$G(TIUY(+TIUJ)),TIURTN=TIURTN+1 ; - modified TIU*1.0*143
. . . I +TIUJ>0,+$G(^TIU(8925,+$G(^TMP("TIUYLIST",$J,+TIUJ)),0)) S TIURTN(TIUI)=+$G(^TMP("TIUYLIST",$J,+TIUJ)),TIURTN=TIURTN+1
K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
Q
;
PREFIX(DA,IDKID) ; Return addendum, urgency, ID indicators.
; I $G(IDKID)=1, include '>' if note is ID kid.
N PREFIX,IDKIDFLG
S PREFIX=""
S IDKIDFLG=1 ; check ID kids too for addenda
I $$HASIDKID^TIUGBR(DA) S PREFIX="<"_PREFIX
I $G(IDKID),$$HASIDDAD^TIUGBR(DA) S PREFIX=">"_PREFIX
I $$HASADDEN^TIULC1(DA,IDKIDFLG) S PREFIX="+"_PREFIX
I +$$URGENCY^TIURM(DA)=1 S PREFIX="*"_PREFIX
I $L(PREFIX) S PREFIX=PREFIX_" "
Q PREFIX
;
SAMPLE(DFN,CLASS) ; Quick sample for range and count
N EARLY,LATE,TOTAL,TIUI,TIUJ,TIUL,TIUY,TIULDA
I '$D(TIUPRM0) D SETPARM^TIULE
S (TIUI,TIUL,TIULDA,LATE,EARLY,TOTAL)=0
F S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:+TIUI'>0 D
. S TIUJ=0
. F S TIUJ=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUJ)) Q:+TIUJ'>0 D
. . I ($P(TIUPRM0,U,6)="S"),(+$$CANDO^TIULP(TIUJ,"VIEW")'>0) Q
. . I +$G(^TIU(8925,+TIUJ,0))=81!'$D(^TIU(8925,+TIUJ,0)) Q
. . S:'LATE LATE=9999999-TIUI
. . S TIUL=TIUI,TOTAL=TOTAL+1,TIULDA=TIUJ
S:+TIUL EARLY=9999999-TIUL
S TIUY=TOTAL_U_EARLY_U_LATE
S:TOTAL=1 TIUY=TIUY_U_TIULDA
Q TIUY
CHOOSE(Y,PROMPT,LO,HI,PAUSE) ; Call reader for pause or list selection
N DIR,DIRUT,DUOUT,DTOUT,X
S DIR(0)="LOA^"_LO_":"_HI
S DIR("A")=PROMPT
D ^DIR
I +$G(PAUSE),(Y="^")!$D(DUOUT)!$D(DIROUT)!$D(DTOUT) S Y=9999999
; B 1
Q
AUTHOR(TERMOK) ; Get author
N TIUY,TIURTYP,TIUPRMT,TIUSCRN,DFLT S TERMOK=+$G(TERMOK)
S:+$$ISA^USRLM(DUZ,"PROVIDER")!+$$ISA^USRLM(DUZ,"STUDENT") DFLT=$$PERSNAME^TIULC1(DUZ)
S TIURTYP="P^200:AEMQZ",TIUPRMT="Select AUTHOR"
S TIUSCRN="I $S(+TERMOK:1,1:'+$$ISTERM^USRLM(+Y))"
S TIUY=$$READ^TIUU(TIURTYP,TIUPRMT,$G(DFLT),"",TIUSCRN)
Q TIUY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULA2 8390 printed Dec 13, 2024@02:42 Page 2
TIULA2 ; SLC/JER - More interactive functions ;10/19/06 14:32
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,50,86,93,61,100,116,143,211**;Jun 20, 1997;Build 26
ASKTYP(TIUCLASS,DFLT,SCREEN,PROMPT,NOLOINC) ; Call ^DIC to select single type
+1 NEW D,DIC,X,Y,TIUFPRIV,ITMCNT
SET TIUFPRIV=1
+2 SET DIC=8925.1
SET TIUCLASS=$GET(TIUCLASS,38)
SET ITMCNT=$$ITMCNT(TIUCLASS)
+3 IF +ITMCNT=1
Begin DoDot:1
+4 IF $PIECE($GET(^TIU(8925.1,+TIUCLASS,0)),U,4)="CL"
Begin DoDot:2
+5 SET TIUCLASS=+$GET(^TIU(8925.1,+TIUCLASS,10,+$PIECE(ITMCNT,U,2),0))
+6 SET Y=$$ASKTYP(+TIUCLASS,DFLT,SCREEN,$GET(PROMPT))
End DoDot:2
QUIT
+7 SET DIC(0)="NX"
SET X=+$GET(^TIU(8925.1,+TIUCLASS,10,+$PIECE(ITMCNT,U,2),0))
+8 DO ^DIC
SET Y=Y_U_"SINGLE ITEM"
End DoDot:1
GOTO ASKTYPX
+9 SET DIC(0)="AEMQZOV"
+10 SET DIC("A")=$SELECT($GET(PROMPT)]"":$GET(PROMPT),1:"Select TITLE: ")
+11 IF $GET(DFLT)="LAST"
SET DFLT=$PIECE($$PERSDOC^TIULE(DUZ,+$GET(TIUCLASS,38)),U,2)
+12 IF +$GET(DFLT)
IF +$DATA(TIUCLASS)
IF (+$$ISA^TIULX(+$GET(DFLT),+$GET(TIUCLASS))'>0)
SET DFLT=""
+13 IF $GET(DFLT)]""
SET DIC("B")=$GET(DFLT)
+14 IF $GET(SCREEN)]""
SET DIC("S")=SCREEN
+15 SET D="B^C^D^E"_$SELECT(+$GET(NOLOINC):"",1:"^LOINC")
+16 DO MIX^DIC1
KILL DIC("S")
ASKTYPX QUIT Y
ITMCNT(CLASS) ; Count the number of members of a class or document class
+1 NEW TIUI,TIUCNT,TIUY
SET (TIUI,TIUCNT,TIUY)=0
+2 FOR
SET TIUI=$ORDER(^TIU(8925.1,+CLASS,10,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 IF +$$CANPICK^TIULP(+$GET(^TIU(8925.1,+CLASS,10,TIUI,0)))
Begin DoDot:2
+4 SET TIUCNT=TIUCNT+1
+5 SET TIUY=TIUCNT_U_TIUI
End DoDot:2
End DoDot:1
+6 QUIT TIUY
DOCPICK(TIUCLASS,DFLT,ADDSCRN) ; Ask for document, given a class or document class
+1 NEW SCREEN,PROMPT
SET PROMPT=$SELECT(TIUCLASS=3:"TITLE: ",1:"")
+2 SET SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",+$$ISA^TIULX(+Y,TIUCLASS),+$$CANPICK^TIULP(+Y)"_$SELECT($GET(ADDSCRN)]"":",",1:"")_$GET(ADDSCRN)
+3 QUIT $$ASKTYP(+TIUCLASS,$GET(DFLT),SCREEN,PROMPT)
DOCSPICK(TIUY,TIUCLASS,PARM,DFLT,PROMPT,ADDSCRN) ; Ask for TITLE(S)
+1 ; with pick-list
+2 NEW SCREEN,Y,ATTCHID
+3 SET DFLT=$SELECT($GET(DFLT)=0:"",$GET(DFLT)]"":$GET(DFLT),1:"LAST")
+4 SET PARM=$SELECT($GET(PARM)]"":PARM,1:"A")
+5 ; D DOCLIST^TIULA1(TIUCLASS,.TIUY,PARM,DFLT) I +TIUY>0 Q
+6 ; ADD CALL TO PERSONAL DOCUMENT LISTER HERE
+7 SET ATTCHID=0
IF $GET(ADDSCRN)["CANLINK^TIULP"
SET ATTCHID=1
+8 IF PARM="1A"
DO TITLPICK^TIULA4(.TIUY,TIUCLASS,ATTCHID)
IF +$GET(TIUY)>0
QUIT
+9 SET PROMPT=$SELECT($GET(PROMPT)]"":$GET(PROMPT),TIUCLASS=3:"TITLE: ",1:"")
+10 SET SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,TIUCLASS)"_$SELECT($GET(ADDSCRN)]"":",",1:"")_$GET(ADDSCRN)
+11 ; User selected "Other title"
IF $GET(TIUY("NODFLT"))
SET DFLT=""
+12 SET TIUY=$$ASKTYP(+TIUCLASS,$GET(DFLT),SCREEN,PROMPT)
+13 IF +TIUY>0
SET TIUY(1)=1_U_TIUY
SET TIUY=1
+14 QUIT
SELPAT(TIURTN,TIUTYP,DFN,TIUASK) ; Select a patient's document
+1 NEW TIUI,TIUQRY,TIUREC,TIUEDT,TIULDT,TIUPRMT,TIUA,TIUZ,TIUTOT,TIUSTOP
+2 NEW TIULAST,TIULIST,TIUJ,TIUY,TIUPNOUN,TIUSMPL,TIUTMP,TIUEDFLT,TIUCONT
+3 KILL ^TMP("TIULIST",$JOB),^TMP("TIULIDX",$JOB)
+4 ; TIU*1.0*143
KILL ^TMP("TIUYLIST",$JOB)
+5 SET TIUTYP=$GET(TIUTYP,38)
+6 SET TIUPNOUN=$SELECT(TIUTYP=3:"notes",TIUTYP=244:"summaries",1:"documents")
+7 IF '+$GET(DFN)
SET DFN=+$$PATIENT^TIULA
if +DFN'>0
QUIT
+8 IF +$ORDER(^TIU(8925,"APTCL",+DFN,+TIUTYP,0))'>0
Begin DoDot:1
+9 WRITE !!,"No ",TIUPNOUN," on file for ",$PIECE(^DPT(+DFN,0),U)
+10 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+11 SET TIUSMPL=$$SAMPLE(DFN,TIUTYP)
+12 IF +TIUSMPL'>0
Begin DoDot:1
+13 WRITE !!,"No ",TIUPNOUN," available for ",$PIECE(^DPT(+DFN,0),U),!
+14 IF $$READ^TIUU("EA","Press RETURN to continue...")
WRITE ""
End DoDot:1
QUIT
+15 SET TIUTOT=+$PIECE(TIUSMPL,U)
+16 SET TIUEDT=+$PIECE(TIUSMPL,U,2)_U_$$DATE^TIULS(+$PIECE(TIUSMPL,U,2),"MM/DD/CCYY")
+17 SET TIULDT=+$PIECE(TIUSMPL,U,3)_U_$$DATE^TIULS(+$PIECE(TIUSMPL,U,3),"MM/DD/CCYY")
+18 WRITE !!,"Available ",TIUPNOUN,": ",$PIECE(TIUEDT,U,2)
+19 WRITE " thru ",$PIECE(TIULDT,U,2)," (",TIUTOT,")"
+20 IF +$GET(TIUASK)>0
Begin DoDot:1
+21 NEW TIUPRMT
SET TIUPRMT="Do you wish to see any of these notes"
+22 SET TIUCONT=+$$READ^TIUU("YO",TIUPRMT,"NO")
End DoDot:1
if +$GET(TIUCONT)'>0
QUIT
+23 IF +TIUTOT=1
IF +$PIECE(TIUSMPL,U,4)
SET TIURTN=1
SET TIURTN(1)=+$PIECE(TIUSMPL,U,4)
QUIT
+24 WRITE !!,"Please specify a date range from which to select ",TIUPNOUN_":"
+25 SET TIUPRMT="List "_TIUPNOUN_" Beginning: "
+26 SET TIUEDFLT=$PIECE(TIUEDT,U)
+27 IF +TIUEDFLT<+$PIECE(TIUEDT,U)
SET TIUEDFLT=$PIECE(TIUEDT,U,2)
+28 IF TIUEDFLT'["/"
SET TIUEDFLT=$$DATE^TIULS(TIUEDFLT,"MM/DD/CCYY")
+29 SET TIUA=+$$READ^TIUU("DA^"_+$PIECE(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,TIUEDFLT)
+30 IF +$DATA(DIRUT)!(TIUA'>0)
QUIT
+31 SET TIUPRMT=$JUSTIFY("Thru: ",$LENGTH(TIUPRMT))
+32 SET TIUZ=+$$READ^TIUU("DA^"_+$PIECE(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,$PIECE(TIULDT,U,2))_".2401"
WRITE !
+33 IF +$DATA(DIRUT)!(TIUA'>0)
QUIT
+34 IF +TIUA>TIUZ
SET TIUTMP=TIUA
SET TIUA=TIUZ
SET TIUZ=TIUTMP
+35 ; ZDEBUG ON B 1
+36 DO LIST^TIUSRVLL(.TIUY,TIUTYP,DFN,TIUA,TIUZ)
+37 ; I $D(TIUY)>9 - modified TIU*1.0*143
IF $DATA(^TMP("TIUYLIST",$JOB))>9
Begin DoDot:1
+38 ; S TIUI=0 F S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0) D ; - modified TIU*1.0*143
+39 SET TIUI=0
FOR
SET TIUI=$ORDER(^TMP("TIUYLIST",$JOB,TIUI))
if +TIUI'>0!(+$GET(TIUSTOP)>0)
QUIT
Begin DoDot:2
+40 NEW TIUD0,TIUD13,TIUD12,TIUD17,TIUDOC,PREFIX
+41 ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)) ; - modified TIU*1.0*143
+42 SET TIUD0=$GET(^TIU(8925,+^TMP("TIUYLIST",$JOB,TIUI),0))
SET TIUD12=$GET(^(12))
+43 ; S TIUD13=$G(^TIU(8925,+TIUY(TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI ; - modified TIU*1.0*143
+44 SET TIUD13=$GET(^TIU(8925,+^TMP("TIUYLIST",$JOB,TIUI),13))
SET TIUD17=$GET(^(17))
SET TIULAST=TIUI
+45 SET TIUDOC=$EXTRACT($$PNAME^TIULC1(+TIUD0),1,36)
+46 IF TIUDOC="Addendum"
SET TIUDOC=TIUDOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUD0,U,6),0)))
+47 ; S PREFIX=$$PREFIX(+TIUY(TIUI),1),TIUDOC=PREFIX_TIUDOC ; - modified TIU*1.0*143
+48 SET PREFIX=$$PREFIX(+^TMP("TIUYLIST",$JOB,TIUI),1)
SET TIUDOC=PREFIX_TIUDOC
+49 IF +$PIECE(TIUD0,U,5)=15
SET TIUDOC=TIUDOC_" (RETRACTED)"
+50 WRITE !,TIUI,?4,$$DATE^TIULS(+TIUD13,"MM/DD/CCYY HR:MIN")
+51 WRITE ?22,TIUDOC
+52 WRITE ?60,$EXTRACT($$NAME^TIULS($$PERSNAME^TIULC1(+$PIECE(TIUD12,U,2)),"LAST,FI"),1,19)
+53 WRITE !?$SELECT($PIECE(TIUD0,U,13)="H":24,1:22),$SELECT($PIECE(TIUD0,U,13)="H":"Adm: ",1:"Visit: "),$$DATE^TIULS($PIECE(TIUD0,U,7),"MM/DD/CCYY")
+54 IF $PIECE(TIUD0,U,13)="H"
WRITE ?41,"Dis: ",$$DATE^TIULS($PIECE(TIUD0,U,8),"MM/DD/CCYY")
+55 IF $LENGTH(TIUD17)
WRITE !,"SUBJECT: ",$EXTRACT(TIUD17,1,70)
+56 IF '(TIUI#5)
IF (TIUI<+$PIECE(TIUY,U))
DO CHOOSE(.TIUSTOP," '^' TO STOP: ",1,TIUI,1)
End DoDot:2
+57 ; I +TIUY=1 S TIURTN(1)=+TIUY(1) D Q ; - modified TIU*1.0*143
+58 IF +TIUY=1
SET TIURTN(1)=+^TMP("TIUYLIST",$JOB,1)
Begin DoDot:2
+59 WRITE !!,"One ",$SELECT(TIUTYP=3:"note",TIUTYP=244:"summary",1:"document")
+60 WRITE " found within date range..."
HANG 1
End DoDot:2
QUIT
+61 IF +$GET(TIUSTOP)>0
IF (+$GET(TIUSTOP)'=9999999)
MERGE TIULIST=TIUSTOP
+62 IF '$TEST
DO CHOOSE(.TIULIST,"Choose one or more "_TIUPNOUN_": (1-"_+$GET(TIULAST)_"): ",1,+$GET(TIULAST))
+63 NEW TIUK
+64 SET TIUK=""
SET TIURTN=0
+65 FOR
SET TIUK=$ORDER(TIULIST(TIUK))
if TIUK=""
QUIT
Begin DoDot:2
+66 FOR TIUI=1:1:$LENGTH(TIULIST(TIUK),",")
Begin DoDot:3
+67 SET TIUJ=$PIECE(TIULIST,",",TIUI)
+68 ; I +TIUJ>0,+$G(^TIU(8925,+$G(TIUY(+TIUJ)),0)) S TIURTN(TIUI)=+$G(TIUY(+TIUJ)),TIURTN=TIURTN+1 ; - modified TIU*1.0*143
+69 IF +TIUJ>0
IF +$GET(^TIU(8925,+$GET(^TMP("TIUYLIST",$JOB,+TIUJ)),0))
SET TIURTN(TIUI)=+$GET(^TMP("TIUYLIST",$JOB,+TIUJ))
SET TIURTN=TIURTN+1
End DoDot:3
End DoDot:2
End DoDot:1
+70 ; TIU*1.0*143
KILL ^TMP("TIUYLIST",$JOB)
+71 QUIT
+72 ;
PREFIX(DA,IDKID) ; Return addendum, urgency, ID indicators.
+1 ; I $G(IDKID)=1, include '>' if note is ID kid.
+2 NEW PREFIX,IDKIDFLG
+3 SET PREFIX=""
+4 ; check ID kids too for addenda
SET IDKIDFLG=1
+5 IF $$HASIDKID^TIUGBR(DA)
SET PREFIX="<"_PREFIX
+6 IF $GET(IDKID)
IF $$HASIDDAD^TIUGBR(DA)
SET PREFIX=">"_PREFIX
+7 IF $$HASADDEN^TIULC1(DA,IDKIDFLG)
SET PREFIX="+"_PREFIX
+8 IF +$$URGENCY^TIURM(DA)=1
SET PREFIX="*"_PREFIX
+9 IF $LENGTH(PREFIX)
SET PREFIX=PREFIX_" "
+10 QUIT PREFIX
+11 ;
SAMPLE(DFN,CLASS) ; Quick sample for range and count
+1 NEW EARLY,LATE,TOTAL,TIUI,TIUJ,TIUL,TIUY,TIULDA
+2 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+3 SET (TIUI,TIUL,TIULDA,LATE,EARLY,TOTAL)=0
+4 FOR
SET TIUI=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+5 SET TIUJ=0
+6 FOR
SET TIUJ=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+7 IF ($PIECE(TIUPRM0,U,6)="S")
IF (+$$CANDO^TIULP(TIUJ,"VIEW")'>0)
QUIT
+8 IF +$GET(^TIU(8925,+TIUJ,0))=81!'$DATA(^TIU(8925,+TIUJ,0))
QUIT
+9 if 'LATE
SET LATE=9999999-TIUI
+10 SET TIUL=TIUI
SET TOTAL=TOTAL+1
SET TIULDA=TIUJ
End DoDot:2
End DoDot:1
+11 if +TIUL
SET EARLY=9999999-TIUL
+12 SET TIUY=TOTAL_U_EARLY_U_LATE
+13 if TOTAL=1
SET TIUY=TIUY_U_TIULDA
+14 QUIT TIUY
CHOOSE(Y,PROMPT,LO,HI,PAUSE) ; Call reader for pause or list selection
+1 NEW DIR,DIRUT,DUOUT,DTOUT,X
+2 SET DIR(0)="LOA^"_LO_":"_HI
+3 SET DIR("A")=PROMPT
+4 DO ^DIR
+5 IF +$GET(PAUSE)
IF (Y="^")!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DTOUT)
SET Y=9999999
+6 ; B 1
+7 QUIT
AUTHOR(TERMOK) ; Get author
+1 NEW TIUY,TIURTYP,TIUPRMT,TIUSCRN,DFLT
SET TERMOK=+$GET(TERMOK)
+2 if +$$ISA^USRLM(DUZ,"PROVIDER")!+$$ISA^USRLM(DUZ,"STUDENT")
SET DFLT=$$PERSNAME^TIULC1(DUZ)
+3 SET TIURTYP="P^200:AEMQZ"
SET TIUPRMT="Select AUTHOR"
+4 SET TIUSCRN="I $S(+TERMOK:1,1:'+$$ISTERM^USRLM(+Y))"
+5 SET TIUY=$$READ^TIUU(TIURTYP,TIUPRMT,$GET(DFLT),"",TIUSCRN)
+6 QUIT TIUY
