| 1 | TIUPREF ; 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 | ;
|
|---|
| 4 | GOODLOC(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 | ;
|
|---|
| 16 | MAIN ; Control branching
|
|---|
| 17 | N DA
|
|---|
| 18 | S DA=+$$GETREC
|
|---|
| 19 | I +DA'>0 Q
|
|---|
| 20 | D EDIT(DA)
|
|---|
| 21 | Q
|
|---|
| 22 | GETREC() ; 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)
|
|---|
| 35 | EDIT(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
|
|---|
| 43 | REQCOS(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
|
|---|
