source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA2.m@ 1704

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