Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIULA2

TIULA2.m

Go to the documentation of this file. 
  1. 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
  1. ASKTYP(TIUCLASS,DFLT,SCREEN,PROMPT,NOLOINC) ; Call ^DIC to select single type
  1.  N D,DIC,X,Y,TIUFPRIV,ITMCNT S TIUFPRIV=1
  1.  S DIC=8925.1,TIUCLASS=$G(TIUCLASS,38),ITMCNT=$$ITMCNT(TIUCLASS)
  1.  I +ITMCNT=1 D  G ASKTYPX
  1.  . I $P($G(^TIU(8925.1,+TIUCLASS,0)),U,4)="CL" D  Q
  1.  . . S TIUCLASS=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
  1.  . . S Y=$$ASKTYP(+TIUCLASS,DFLT,SCREEN,$G(PROMPT))
  1.  . S DIC(0)="NX",X=+$G(^TIU(8925.1,+TIUCLASS,10,+$P(ITMCNT,U,2),0))
  1.  . D ^DIC S Y=Y_U_"SINGLE ITEM"
  1.  S DIC(0)="AEMQZOV"
  1.  S DIC("A")=$S($G(PROMPT)]"":$G(PROMPT),1:"Select TITLE: ")
  1.  I $G(DFLT)="LAST" S DFLT=$P($$PERSDOC^TIULE(DUZ,+$G(TIUCLASS,38)),U,2)
  1.  I +$G(DFLT),+$D(TIUCLASS),(+$$ISA^TIULX(+$G(DFLT),+$G(TIUCLASS))'>0) S DFLT=""
  1.  I $G(DFLT)]"" S DIC("B")=$G(DFLT)
  1.  I $G(SCREEN)]"" S DIC("S")=SCREEN
  1.  S D="B^C^D^E"_$S(+$G(NOLOINC):"",1:"^LOINC")
  1.  D MIX^DIC1 K DIC("S")
  1. ASKTYPX Q Y
  1. ITMCNT(CLASS) ; Count the number of members of a class or document class
  1.  N TIUI,TIUCNT,TIUY S (TIUI,TIUCNT,TIUY)=0
  1.  F  S TIUI=$O(^TIU(8925.1,+CLASS,10,TIUI)) Q:+TIUI'>0  D 
  1.  . I +$$CANPICK^TIULP(+$G(^TIU(8925.1,+CLASS,10,TIUI,0))) D
  1.  . . S TIUCNT=TIUCNT+1
  1.  . . S TIUY=TIUCNT_U_TIUI
  1.  Q TIUY
  1. DOCPICK(TIUCLASS,DFLT,ADDSCRN) ; Ask for document, given a class or document class
  1.  N SCREEN,PROMPT S PROMPT=$S(TIUCLASS=3:"TITLE: ",1:"")
  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)
  1.  Q $$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
  1. DOCSPICK(TIUY,TIUCLASS,PARM,DFLT,PROMPT,ADDSCRN) ; Ask for TITLE(S)
  1.  ; with pick-list
  1.  N SCREEN,Y,ATTCHID
  1.  S DFLT=$S($G(DFLT)=0:"",$G(DFLT)]"":$G(DFLT),1:"LAST")
  1.  S PARM=$S($G(PARM)]"":PARM,1:"A")
  1.  ; D DOCLIST^TIULA1(TIUCLASS,.TIUY,PARM,DFLT) I +TIUY>0 Q
  1.  ; ADD CALL TO PERSONAL DOCUMENT LISTER HERE
  1.  S ATTCHID=0 I $G(ADDSCRN)["CANLINK^TIULP" S ATTCHID=1
  1.  I PARM="1A" D TITLPICK^TIULA4(.TIUY,TIUCLASS,ATTCHID) I +$G(TIUY)>0 Q
  1.  S PROMPT=$S($G(PROMPT)]"":$G(PROMPT),TIUCLASS=3:"TITLE: ",1:"")
  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)
  1.  I $G(TIUY("NODFLT")) S DFLT="" ; User selected "Other title"
  1.  S TIUY=$$ASKTYP(+TIUCLASS,$G(DFLT),SCREEN,PROMPT)
  1.  I +TIUY>0 S TIUY(1)=1_U_TIUY,TIUY=1
  1.  Q
  1. SELPAT(TIURTN,TIUTYP,DFN,TIUASK) ; Select a patient's document
  1.  N TIUI,TIUQRY,TIUREC,TIUEDT,TIULDT,TIUPRMT,TIUA,TIUZ,TIUTOT,TIUSTOP
  1.  N TIULAST,TIULIST,TIUJ,TIUY,TIUPNOUN,TIUSMPL,TIUTMP,TIUEDFLT,TIUCONT
  1.  K ^TMP("TIULIST",$J),^TMP("TIULIDX",$J)
  1.  K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
  1.  S TIUTYP=$G(TIUTYP,38)
  1.  S TIUPNOUN=$S(TIUTYP=3:"notes",TIUTYP=244:"summaries",1:"documents")
  1.  I '+$G(DFN) S DFN=+$$PATIENT^TIULA Q:+DFN'>0
  1.  I +$O(^TIU(8925,"APTCL",+DFN,+TIUTYP,0))'>0 D  Q
  1.  . W !!,"No ",TIUPNOUN," on file for ",$P(^DPT(+DFN,0),U)
  1.  . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1.  S TIUSMPL=$$SAMPLE(DFN,TIUTYP)
  1.  I +TIUSMPL'>0 D  Q
  1.  . W !!,"No ",TIUPNOUN," available for ",$P(^DPT(+DFN,0),U),!
  1.  . I $$READ^TIUU("EA","Press RETURN to continue...") W ""
  1.  S TIUTOT=+$P(TIUSMPL,U)
  1.  S TIUEDT=+$P(TIUSMPL,U,2)_U_$$DATE^TIULS(+$P(TIUSMPL,U,2),"MM/DD/CCYY")
  1.  S TIULDT=+$P(TIUSMPL,U,3)_U_$$DATE^TIULS(+$P(TIUSMPL,U,3),"MM/DD/CCYY")
  1.  W !!,"Available ",TIUPNOUN,":  ",$P(TIUEDT,U,2)
  1.  W " thru ",$P(TIULDT,U,2),"  (",TIUTOT,")"
  1.  I +$G(TIUASK)>0 D  Q:+$G(TIUCONT)'>0
  1.  . N TIUPRMT S TIUPRMT="Do you wish to see any of these notes"
  1.  . S TIUCONT=+$$READ^TIUU("YO",TIUPRMT,"NO")
  1.  I +TIUTOT=1,+$P(TIUSMPL,U,4) S TIURTN=1,TIURTN(1)=+$P(TIUSMPL,U,4) Q
  1.  W !!,"Please specify a date range from which to select ",TIUPNOUN_":"
  1.  S TIUPRMT="List "_TIUPNOUN_" Beginning: "
  1.  S TIUEDFLT=$P(TIUEDT,U)
  1.  I +TIUEDFLT<+$P(TIUEDT,U) S TIUEDFLT=$P(TIUEDT,U,2)
  1.  I TIUEDFLT'["/" S TIUEDFLT=$$DATE^TIULS(TIUEDFLT,"MM/DD/CCYY")
  1.  S TIUA=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,TIUEDFLT)
  1.  I +$D(DIRUT)!(TIUA'>0) Q
  1.  S TIUPRMT=$J("Thru: ",$L(TIUPRMT))
  1.  S TIUZ=+$$READ^TIUU("DA^"_+$P(TIUEDT,".")_":"_+TIULDT_":E",TIUPRMT,$P(TIULDT,U,2))_".2401" W !
  1.  I +$D(DIRUT)!(TIUA'>0) Q
  1.  I +TIUA>TIUZ S TIUTMP=TIUA,TIUA=TIUZ,TIUZ=TIUTMP
  1.  ; ZDEBUG ON B 1
  1.  D LIST^TIUSRVLL(.TIUY,TIUTYP,DFN,TIUA,TIUZ)
  1.  I $D(^TMP("TIUYLIST",$J))>9 D  ; I $D(TIUY)>9 - modified TIU*1.0*143
  1.  . ; S TIUI=0 F  S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0)  D ; - modified TIU*1.0*143
  1.  . S TIUI=0 F  S TIUI=$O(^TMP("TIUYLIST",$J,TIUI)) Q:+TIUI'>0!(+$G(TIUSTOP)>0)  D
  1.  . . N TIUD0,TIUD13,TIUD12,TIUD17,TIUDOC,PREFIX
  1.  . . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)) ; - modified TIU*1.0*143
  1.  . . S TIUD0=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),0)),TIUD12=$G(^(12))
  1.  . . ; S TIUD13=$G(^TIU(8925,+TIUY(TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI ; - modified TIU*1.0*143
  1.  . . S TIUD13=$G(^TIU(8925,+^TMP("TIUYLIST",$J,TIUI),13)),TIUD17=$G(^(17)),TIULAST=TIUI
  1.  . . S TIUDOC=$E($$PNAME^TIULC1(+TIUD0),1,36)
  1.  . . I TIUDOC="Addendum" S TIUDOC=TIUDOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
  1.  . . ; S PREFIX=$$PREFIX(+TIUY(TIUI),1),TIUDOC=PREFIX_TIUDOC ; - modified TIU*1.0*143
  1.  . . S PREFIX=$$PREFIX(+^TMP("TIUYLIST",$J,TIUI),1),TIUDOC=PREFIX_TIUDOC
  1.  . . I +$P(TIUD0,U,5)=15 S TIUDOC=TIUDOC_" (RETRACTED)"
  1.  . . W !,TIUI,?4,$$DATE^TIULS(+TIUD13,"MM/DD/CCYY HR:MIN")
  1.  . . W ?22,TIUDOC
  1.  . . W ?60,$E($$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI"),1,19)
  1.  . . 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")
  1.  . . I $P(TIUD0,U,13)="H" W ?41,"Dis: ",$$DATE^TIULS($P(TIUD0,U,8),"MM/DD/CCYY")
  1.  . . I $L(TIUD17) W !,"SUBJECT: ",$E(TIUD17,1,70)
  1.  . . I '(TIUI#5),(TIUI<+$P(TIUY,U)) D CHOOSE(.TIUSTOP,"   '^' TO STOP: ",1,TIUI,1)
  1.  . ; I +TIUY=1 S TIURTN(1)=+TIUY(1) D  Q  ; - modified TIU*1.0*143
  1.  . I +TIUY=1 S TIURTN(1)=+^TMP("TIUYLIST",$J,1) D  Q
  1.  . . W !!,"One ",$S(TIUTYP=3:"note",TIUTYP=244:"summary",1:"document")
  1.  . . W " found within date range..." H 1
  1.  . I +$G(TIUSTOP)>0,(+$G(TIUSTOP)'=9999999) M TIULIST=TIUSTOP
  1.  . E  D CHOOSE(.TIULIST,"Choose one or more "_TIUPNOUN_":  (1-"_+$G(TIULAST)_"): ",1,+$G(TIULAST))
  1.  . N TIUK
  1.  . S TIUK="",TIURTN=0
  1.  . F  S TIUK=$O(TIULIST(TIUK)) Q:TIUK=""  D
  1.  . . F TIUI=1:1:$L(TIULIST(TIUK),",") D
  1.  . . . S TIUJ=$P(TIULIST,",",TIUI)
  1.  . . . ; I +TIUJ>0,+$G(^TIU(8925,+$G(TIUY(+TIUJ)),0)) S TIURTN(TIUI)=+$G(TIUY(+TIUJ)),TIURTN=TIURTN+1 ; - modified TIU*1.0*143
  1.  . . . I +TIUJ>0,+$G(^TIU(8925,+$G(^TMP("TIUYLIST",$J,+TIUJ)),0)) S TIURTN(TIUI)=+$G(^TMP("TIUYLIST",$J,+TIUJ)),TIURTN=TIURTN+1
  1.  K ^TMP("TIUYLIST",$J) ; TIU*1.0*143
  1.  Q
  1.  ;
  1. PREFIX(DA,IDKID) ; Return addendum, urgency, ID indicators.
  1.  ; I $G(IDKID)=1, include '>' if note is ID kid.
  1.  N PREFIX,IDKIDFLG
  1.  S PREFIX=""
  1.  S IDKIDFLG=1 ; check ID kids too for addenda
  1.  I $$HASIDKID^TIUGBR(DA) S PREFIX="<"_PREFIX
  1.  I $G(IDKID),$$HASIDDAD^TIUGBR(DA) S PREFIX=">"_PREFIX
  1.  I $$HASADDEN^TIULC1(DA,IDKIDFLG) S PREFIX="+"_PREFIX
  1.  I +$$URGENCY^TIURM(DA)=1 S PREFIX="*"_PREFIX
  1.  I $L(PREFIX) S PREFIX=PREFIX_" "
  1.  Q PREFIX
  1.  ;
  1. SAMPLE(DFN,CLASS) ; Quick sample for range and count
  1.  N EARLY,LATE,TOTAL,TIUI,TIUJ,TIUL,TIUY,TIULDA
  1.  I '$D(TIUPRM0) D SETPARM^TIULE
  1.  S (TIUI,TIUL,TIULDA,LATE,EARLY,TOTAL)=0
  1.  F  S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:+TIUI'>0  D
  1.  . S TIUJ=0
  1.  . F  S TIUJ=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,TIUJ)) Q:+TIUJ'>0  D
  1.  . . I ($P(TIUPRM0,U,6)="S"),(+$$CANDO^TIULP(TIUJ,"VIEW")'>0) Q
  1.  . . I +$G(^TIU(8925,+TIUJ,0))=81!'$D(^TIU(8925,+TIUJ,0)) Q
  1.  . . S:'LATE LATE=9999999-TIUI
  1.  . . S TIUL=TIUI,TOTAL=TOTAL+1,TIULDA=TIUJ
  1.  S:+TIUL EARLY=9999999-TIUL
  1.  S TIUY=TOTAL_U_EARLY_U_LATE
  1.  S:TOTAL=1 TIUY=TIUY_U_TIULDA
  1.  Q TIUY
  1. CHOOSE(Y,PROMPT,LO,HI,PAUSE) ; Call reader for pause or list selection
  1.  N DIR,DIRUT,DUOUT,DTOUT,X
  1.  S DIR(0)="LOA^"_LO_":"_HI
  1.  S DIR("A")=PROMPT
  1.  D ^DIR
  1.  I +$G(PAUSE),(Y="^")!$D(DUOUT)!$D(DIROUT)!$D(DTOUT) S Y=9999999
  1.  ; B 1
  1.  Q
  1. AUTHOR(TERMOK) ; Get author
  1.  N TIUY,TIURTYP,TIUPRMT,TIUSCRN,DFLT S TERMOK=+$G(TERMOK)
  1.  S:+$$ISA^USRLM(DUZ,"PROVIDER")!+$$ISA^USRLM(DUZ,"STUDENT") DFLT=$$PERSNAME^TIULC1(DUZ)
  1.  S TIURTYP="P^200:AEMQZ",TIUPRMT="Select AUTHOR"
  1.  S TIUSCRN="I $S(+TERMOK:1,1:'+$$ISTERM^USRLM(+Y))"
  1.  S TIUY=$$READ^TIUU(TIURTYP,TIUPRMT,$G(DFLT),"",TIUSCRN)
  1.  Q TIUY