source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA3.m@ 1524

Last change on this file since 1524 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.3 KB
Line 
1TIULA3 ; SLC/JER - Still more interactive functions ;24-FEB-2000 12:22:04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98**;Jun 20, 1997
3TITLE ; Title Look-up
4 N TIUI,TYPE,TIUCLASS S TIUI=0
5 S TIUTYP=$NA(^TMP("TIUTYP",$J))
6 K @TIUTYP
7 I +$G(TIUPICT)'>0 Q
8 I $P($G(TIUPICT(1)),U,4)="ALL" D
9 . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0))
10 . K TIUPICT
11 . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS)
12 F S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0 D
13 . S TIUCLASS=$P(TIUPICT(TIUI),U,2)
14 . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": "
15 . D TITLPICK(.TYPE,TIUCLASS)
16 M @TIUTYP=TYPE
17 S Y="ANY"
18 Q
19TITLPICK(TIUTYP,CLASS) ; Select multiple titles
20 N TIUI,TYPE,TIUPRMT S TIUI=0
21 W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
22 W " TITLES to search for:",!
23 F D Q:+$G(TYPE)'>0
24 . K TYPE
25 . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
26 . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT)
27 . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1))
28 . I I $P(TYPE(1),U,4)="SINGLE ITEM" D
29 . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
30 . . S TYPE=0
31 . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1
32 W !
33 Q
34ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class
35 N TIUY,TIUTYP,DFLT,SCREEN,X,Y
36 S DFLT=$$RSLVTITL(TIUTTL)
37 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)"
38 S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ")
39 I +$G(TIUY)'>0 S TIUY=TIUTTL
40 Q TIUY
41RSLVTITL(TIUTTL) ; Resolve pointers to titles
42 Q $P($G(^TIU(8925.1,+TIUTTL,0)),U)
43ASKSEQ(TIUDFLT) ; Ask preferred sort sequence
44 N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D")
45 S TIUPRMT="Please Specify Sort Order: "
46 S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)"
47 S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending"))
48 Q TIUY
49DATENOTE(X) ; Ask for date/time of note
50 N %DT,Y
51 ;S TIUPRMT="DATE/TIME OF NOTE"
52 ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP)
53 ;I +TIUY W " ",$P(TIUY,U,2)
54 S %DT="RSX",%DT(0)="-NOW" D ^%DT
55 I +Y'>0 D
56 . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)."
57 Q +$G(Y)
58SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign
59 N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
60 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
61 ; If he requires cosignature for this document a user may NOT select
62 ; himself
63 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX
64 ; A TERMINATED User may NOT be selected
65 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
66 ; A non-PROVIDER may NOT be selected
67 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
68 ; Author may NOT be selected
69 I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
70 ; Expected Signer may NOT be selected
71 I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
72 ; Others who require Cosignature may NOT be selected
73 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0
74SCREENX Q +$G(TIUY)
75SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER
76 N TIUY S TIUY=1
77 S USER=$G(USER,DUZ)
78 ; A user may NOT select himself
79 I Y=USER S TIUY=0 G SCRDFX
80 ; A TERMINATED User may NOT be selected
81 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
82 ; A non-PROVIDER may NOT be selected
83 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
84SCRDFX Q TIUY
Note: See TracBrowser for help on using the repository browser.