source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA3.m@ 1783

TIULA3 ; SLC/JER - Still more interactive functions ;24-FEB-2000 12:22:04
 ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98**;Jun 20, 1997
TITLE ; Title Look-up
 N TIUI,TYPE,TIUCLASS S TIUI=0
 S TIUTYP=$NA(^TMP("TIUTYP",$J))
 K @TIUTYP
 I +$G(TIUPICT)'>0 Q
 I $P($G(TIUPICT(1)),U,4)="ALL" D
 . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0))
 . K TIUPICT
 . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS)
 F  S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0  D
 . S TIUCLASS=$P(TIUPICT(TIUI),U,2)
 . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),":  "
 . D TITLPICK(.TYPE,TIUCLASS)
 M @TIUTYP=TYPE
 S Y="ANY"
 Q
TITLPICK(TIUTYP,CLASS) ; Select multiple titles
 N TIUI,TYPE,TIUPRMT S TIUI=0
 W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
 W " TITLES to search for:",!
 F  D  Q:+$G(TYPE)'>0
 . K TYPE
 . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_")  "
 . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT)
 . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1))
 . I  I $P(TYPE(1),U,4)="SINGLE ITEM" D
 . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
 . . S TYPE=0
 . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1
 W !
 Q
ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class
 N TIUY,TIUTYP,DFLT,SCREEN,X,Y
 S DFLT=$$RSLVTITL(TIUTTL)
 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)"
 S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ")
 I +$G(TIUY)'>0 S TIUY=TIUTTL
 Q TIUY
RSLVTITL(TIUTTL) ; Resolve pointers to titles
 Q $P($G(^TIU(8925.1,+TIUTTL,0)),U)
ASKSEQ(TIUDFLT) ; Ask preferred sort sequence
 N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D")
 S TIUPRMT="Please Specify Sort Order: "
 S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)"
 S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending"))
 Q TIUY
DATENOTE(X) ; Ask for date/time of note
 N %DT,Y
 ;S TIUPRMT="DATE/TIME OF NOTE"
 ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP)
 ;I +TIUY W "     ",$P(TIUY,U,2)
 S %DT="RSX",%DT(0)="-NOW" D ^%DT
 I +Y'>0 D
 . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)."
 Q +$G(Y)
SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign
 N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
 ; If he requires cosignature for this document a user may NOT select
 ; himself
 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX
 ; A TERMINATED User may NOT be selected
 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
 ; A non-PROVIDER may NOT be selected
 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
 ; Author may NOT be selected
 I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
 ; Expected Signer may NOT be selected
 I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
 ; Others who require Cosignature may NOT be selected
 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0
SCREENX Q +$G(TIUY)
SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER
 N TIUY S TIUY=1
 S USER=$G(USER,DUZ)
 ; A user may NOT select himself
 I Y=USER S TIUY=0 G SCRDFX
 ; A TERMINATED User may NOT be selected
 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
 ; A non-PROVIDER may NOT be selected
 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
SCRDFX Q TIUY