17 lines
473 B
Mathematica
17 lines
473 B
Mathematica
FHOMUPD ;Hines OIFO/RTK OUTPATIENT MEALS UPDATE INP/OUTP FIELD ;9/18/03 13:15
|
|
;;5.5;DIETETICS;;Jan 28, 2005
|
|
;
|
|
Q
|
|
;
|
|
F FHPTIEN=0:0 S FHPTIEN=$O(^FHPT(FHPTIEN)) Q:FHPTIEN'>0 D
|
|
.S FHPTNUM=$P($G(^FHPT(FHPTIEN,0)),U,1)
|
|
.S FHIOFLD=$P($G(^FHPT(FHPTIEN,0)),U,2)
|
|
.I FHPTNUM["N",FHIOFLD'="O" S FHVAL="O" D UPD Q
|
|
.S FHDPTR=$E(FHPTNUM,2,99) I FHDPTR="" Q
|
|
.I $D(^DPT(FHDPTR,.1)) S FHVAL="I" D UPD Q
|
|
Q
|
|
UPD ;
|
|
K DIE S DIE="^FHPT(",DA=FHPTIEN
|
|
S DR="13////^S X=FHVAL" D ^DIE
|
|
Q
|