52 lines
2.0 KiB
Mathematica
52 lines
2.0 KiB
Mathematica
TIUPREF ; SLC/JER - Enter/edit personal preferences ; 19-AUG-2002 13:10:05
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**10,91,103,111,141**;Jun 20, 1997
|
|
;
|
|
GOODLOC(LOC) ; Returns 1 if ^SC hospital location IFN LOC is good, else 0
|
|
; Used in TIUVSIT, in DDs for LOCATION field of 8926
|
|
N GOODLOC,INACTIVE,OOS,CLINIC S (GOODLOC,INACTIVE)=0
|
|
I +$G(^SC(LOC,"I"))>0,(+$G(^("I"))'>DT) D
|
|
. S INACTIVE=1
|
|
. ; check if reactivated:
|
|
. I +$P($G(^("I")),U,2)>0,$P($G(^("I")),U,2)'>DT S INACTIVE=0
|
|
S OOS=+$D(^SC(LOC,"OOS")) ; Occasion of service
|
|
S CLINIC=+($P(^SC(LOC,0),U,3)="C")
|
|
I 'INACTIVE,'OOS,CLINIC S GOODLOC=1
|
|
Q GOODLOC
|
|
;
|
|
MAIN ; Control branching
|
|
N DA
|
|
S DA=+$$GETREC
|
|
I +DA'>0 Q
|
|
D EDIT(DA)
|
|
Q
|
|
GETREC() ; Get record in picklist file
|
|
N DIC,DLAYGO,TIUNM,X,Y,ASKNEW
|
|
S (DIC,DLAYGO)=8926,DIC(0)="NXLZ"
|
|
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
|
|
S X="`"_DUZ,TIUNM=$P(^VA(200,+$G(DUZ),0),U)
|
|
W !," Enter/edit Personal Preferences"
|
|
W !!?5,TIUNM
|
|
D ^DIC
|
|
;TIU*1*91 If DIC adds new entry, can get anyone w/ same name:
|
|
I Y>0,+Y(0)'=DUZ N DA,DIK D
|
|
. W !!," Sorry, you can edit preferences for YOURSELF only. Please try again."
|
|
. I $P(Y,U,3)=1 S DA=+Y,DIK="^TIU(8926," D ^DIK S Y=-1
|
|
Q +$G(Y)
|
|
EDIT(DA) ; Call ^DIE to edit the record
|
|
N DIE,DR,TIUCLASS,TIUREQCS,LOC
|
|
S DIE=8926,TIUREQCS=+$$REQCOS(DUZ)
|
|
S LOC=+$P(^TIU(8926,DA,0),U,2)
|
|
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
|
|
S DR=".02:.08;.1;.11;I +TIUREQCS'>0 S Y=""@1"";.09;@1;1"
|
|
S DR(2,8926.01)=".01;.02;.03" D ^DIE
|
|
Q
|
|
REQCOS(DUZ) ; Does user require cosignature for any documents
|
|
N TIUI,TIUJ,TIUC,TIUY S (TIUI,TIUY)=0
|
|
; Is the user required to have a cosignature on any document?
|
|
F S TIUI=$O(^TIU(8925.95,TIUI)) Q:+TIUI'>0!+TIUY D
|
|
. S TIUJ=0
|
|
. F S TIUJ=$O(^TIU(8925.95,TIUI,5,TIUJ)) Q:+TIUJ'>0!+TIUY D
|
|
. . S TIUC=+$G(^TIU(8925.95,TIUI,5,TIUJ,0)) Q:+TIUC'>0
|
|
. . S TIUY=+$$ISA^USRLM(DUZ,TIUC)
|
|
Q TIUY
|