source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPREF.m@ 901

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1TIUPREF ; SLC/JER - Enter/edit personal preferences ; 19-AUG-2002 13:10:05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**10,91,103,111,141**;Jun 20, 1997
3 ;
4GOODLOC(LOC) ; Returns 1 if ^SC hospital location IFN LOC is good, else 0
5 ; Used in TIUVSIT, in DDs for LOCATION field of 8926
6 N GOODLOC,INACTIVE,OOS,CLINIC S (GOODLOC,INACTIVE)=0
7 I +$G(^SC(LOC,"I"))>0,(+$G(^("I"))'>DT) D
8 . S INACTIVE=1
9 . ; check if reactivated:
10 . I +$P($G(^("I")),U,2)>0,$P($G(^("I")),U,2)'>DT S INACTIVE=0
11 S OOS=+$D(^SC(LOC,"OOS")) ; Occasion of service
12 S CLINIC=+($P(^SC(LOC,0),U,3)="C")
13 I 'INACTIVE,'OOS,CLINIC S GOODLOC=1
14 Q GOODLOC
15 ;
16MAIN ; Control branching
17 N DA
18 S DA=+$$GETREC
19 I +DA'>0 Q
20 D EDIT(DA)
21 Q
22GETREC() ; Get record in picklist file
23 N DIC,DLAYGO,TIUNM,X,Y,ASKNEW
24 S (DIC,DLAYGO)=8926,DIC(0)="NXLZ"
25 S DIC("S")="I $P(^(0),U)=DUZ" ;TIU*1*91 If user already in file but has same name as another entry, select user
26 S X="`"_DUZ,TIUNM=$P(^VA(200,+$G(DUZ),0),U)
27 W !," Enter/edit Personal Preferences"
28 W !!?5,TIUNM
29 D ^DIC
30 ;TIU*1*91 If DIC adds new entry, can get anyone w/ same name:
31 I Y>0,+Y(0)'=DUZ N DA,DIK D
32 . W !!," Sorry, you can edit preferences for YOURSELF only. Please try again."
33 . I $P(Y,U,3)=1 S DA=+Y,DIK="^TIU(8926," D ^DIK S Y=-1
34 Q +$G(Y)
35EDIT(DA) ; Call ^DIE to edit the record
36 N DIE,DR,TIUCLASS,TIUREQCS,LOC
37 S DIE=8926,TIUREQCS=+$$REQCOS(DUZ)
38 S LOC=+$P(^TIU(8926,DA,0),U,2)
39 I LOC>0,'$$GOODLOC(LOC) W !," Your default location is no longer valid and has been deleted.",!," Please choose a new one." S DR=".02///@" D ^DIE
40 S DR=".02:.08;.1;.11;I +TIUREQCS'>0 S Y=""@1"";.09;@1;1"
41 S DR(2,8926.01)=".01;.02;.03" D ^DIE
42 Q
43REQCOS(DUZ) ; Does user require cosignature for any documents
44 N TIUI,TIUJ,TIUC,TIUY S (TIUI,TIUY)=0
45 ; Is the user required to have a cosignature on any document?
46 F S TIUI=$O(^TIU(8925.95,TIUI)) Q:+TIUI'>0!+TIUY D
47 . S TIUJ=0
48 . F S TIUJ=$O(^TIU(8925.95,TIUI,5,TIUJ)) Q:+TIUJ'>0!+TIUY D
49 . . S TIUC=+$G(^TIU(8925.95,TIUI,5,TIUJ,0)) Q:+TIUC'>0
50 . . S TIUY=+$$ISA^USRLM(DUZ,TIUC)
51 Q TIUY
Note: See TracBrowser for help on using the repository browser.