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

TIULA3.m

Go to the documentation of this file.
  1. TIULA3 ; SLC/JER - Still more interactive functions ;1/31/08
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98,219**;Jun 20, 1997;Build 11
  1. TITLE ; Title Look-up
  1. N TIUI,TYPE,TIUCLASS S TIUI=0
  1. S TIUTYP=$NA(^TMP("TIUTYP",$J))
  1. K @TIUTYP
  1. I +$G(TIUPICT)'>0 Q
  1. I $P($G(TIUPICT(1)),U,4)="ALL" D
  1. . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0))
  1. . K TIUPICT
  1. . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS)
  1. F S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0 D
  1. . S TIUCLASS=$P(TIUPICT(TIUI),U,2)
  1. . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": "
  1. . D TITLPICK(.TYPE,TIUCLASS)
  1. M @TIUTYP=TYPE
  1. S Y="ANY"
  1. Q
  1. TITLPICK(TIUTYP,CLASS) ; Select multiple titles
  1. N TIUI,TYPE,TIUPRMT S TIUI=0
  1. W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
  1. W " TITLES to search for:",!
  1. F D Q:+$G(TYPE)'>0
  1. . K TYPE
  1. . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
  1. . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT)
  1. . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1))
  1. . I I $P(TYPE(1),U,4)="SINGLE ITEM" D
  1. . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
  1. . . S TYPE=0
  1. . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1
  1. W !
  1. Q
  1. ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class
  1. N TIUY,TIUTYP,DFLT,SCREEN,X,Y
  1. S DFLT=$$RSLVTITL(TIUTTL)
  1. S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,CLASS),+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)"
  1. S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ")
  1. I +$G(TIUY)'>0 S TIUY=TIUTTL
  1. Q TIUY
  1. RSLVTITL(TIUTTL) ; Resolve pointers to titles
  1. Q $P($G(^TIU(8925.1,+TIUTTL,0)),U)
  1. ASKSEQ(TIUDFLT) ; Ask preferred sort sequence
  1. N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D")
  1. S TIUPRMT="Please Specify Sort Order: "
  1. S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)"
  1. S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending"))
  1. Q TIUY
  1. DATENOTE(X) ; Ask for date/time of note
  1. N %DT,Y
  1. ;S TIUPRMT="DATE/TIME OF NOTE"
  1. ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP)
  1. ;I +TIUY W " ",$P(TIUY,U,2)
  1. S %DT="RSX",%DT(0)="-NOW" D ^%DT
  1. I +Y'>0 D
  1. . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)."
  1. Q +$G(Y)
  1. SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign
  1. N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
  1. S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
  1. ; If he requires cosignature for this document a user may NOT select
  1. ; himself
  1. I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX
  1. ; A TERMINATED User may NOT be selected
  1. I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
  1. ; A non-PROVIDER may NOT be selected
  1. I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
  1. ; Author may NOT be selected
  1. I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
  1. ; Expected Signer may NOT be selected
  1. I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
  1. ; Others who require Cosignature may NOT be selected
  1. I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0
  1. SCREENX Q +$G(TIUY)
  1. ;
  1. SCRATT(TIUDA,PERSON) ; Can a person be an Attending for a given docmt?
  1. N TIUD0,TIUTYP,CANSEL,DICTDT,TIUISDS,TIUPRNT,TIUPTYP,TIUPD0,TIUISAD
  1. S PERSON=+PERSON,TIUDA=+TIUDA,CANSEL=1
  1. S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUPRNT=+$P(TIUD0,U,6)
  1. S DICTDT=+$P($G(^TIU(8925,+TIUDA,13)),U,7)
  1. I DICTDT>0 S DICTDT=$P(DICTDT,".")
  1. ; Is Docmt an Addendum, a DS?
  1. S TIUTYP=+TIUD0,(TIUPTYP,TIUISAD)=0
  1. I TIUPRNT>0 S TIUPTYP=+$G(^TIU(8925,TIUPRNT,0))
  1. I TIUPTYP>0,$P($G(^TIU(8925.1,TIUTYP,0)),U)["ADDENDUM" S TIUISAD=1
  1. S TIUISDS=+$S('TIUISAD:$$ISDS^TIULX(TIUTYP),1:$$ISDS^TIULX(TIUPTYP))
  1. ; A TERMINATED (as of NOW) User may NOT be selected:
  1. I $$ISTERM^USRLM(PERSON) S CANSEL=0 G SCRATTX
  1. ; If not DS, is person an active provider?
  1. I 'TIUISDS S:'$$PROVIDER^TIUPXAP1(PERSON,DT) CANSEL=0 G SCRATTX
  1. ; TIUDA is a DS:
  1. ; Attendings must be in USR Class PROVIDER NOW:
  1. I '$$ISA^USRLM(+PERSON,"PROVIDER") S CANSEL=0 G SCRATTX
  1. ; Persons who require Cosignature on Dictation Dt may NOT be selected:
  1. I +$$REQCOSIG^TIULP(TIUTYP,+TIUDA,PERSON,DICTDT) S CANSEL=0
  1. SCRATTX Q +$G(CANSEL)
  1. ;
  1. SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER
  1. N TIUY S TIUY=1
  1. S USER=$G(USER,DUZ)
  1. ; A user may NOT select himself
  1. I Y=USER S TIUY=0 G SCRDFX
  1. ; A TERMINATED User may NOT be selected
  1. I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
  1. ; A non-PROVIDER may NOT be selected
  1. I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
  1. SCRDFX Q TIUY