19 lines
681 B
Mathematica
19 lines
681 B
Mathematica
FHWMAS ; HISC/REL - Process MAS Events ;2/1/95 08:53
|
|
;;5.5;DIETETICS;;Jan 28, 2005
|
|
S FHMAS3=0
|
|
S FHZ115="P"_DFN D ADD^FHOMDPA I FHDFN="" Q
|
|
F FHMAS1=0:0 S FHMAS1=$O(^UTILITY("DGPM",$J,FHMAS1)) Q:FHMAS1=""!(FHMAS1>3) D:'FHMAS3 A0 F FHMAS2=0:0 S FHMAS2=$O(^UTILITY("DGPM",$J,FHMAS1,FHMAS2)) Q:FHMAS2="" S FHNEW=$G(^(FHMAS2,"A")),FHOLD=$G(^("P")) D A1
|
|
K A0,ADM,FHWF,WARD,FHMAS1,FHMAS2,FHMAS3,FHNEW,FHOLD,X Q
|
|
A0 S FHMAS3=1 Q
|
|
A1 I FHNEW="" G DEL
|
|
; New/Edit actions
|
|
S ADM=$P(FHNEW,"^",14) Q:'ADM
|
|
I FHMAS1=1 Q:$P(FHNEW,"^",17) G ^FHWADM
|
|
I FHMAS1=2 G ^FHWTRN
|
|
G ^FHWDIS
|
|
DEL ; Delete actions
|
|
S ADM=$P(FHOLD,"^",14) Q:'ADM
|
|
I FHMAS1=1 G ^FHWDIS
|
|
I FHMAS1=2 G ^FHWTRN
|
|
G ^FHWDISD
|