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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMUPD 489 printed Dec 13, 2024@01:53:12 Page 2
FHOMUPD ;Hines OIFO/RTK OUTPATIENT MEALS UPDATE INP/OUTP FIELD ;9/18/03 13:15
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
+3 QUIT
+4 ;
+5 FOR FHPTIEN=0:0
SET FHPTIEN=$ORDER(^FHPT(FHPTIEN))
if FHPTIEN'>0
QUIT
Begin DoDot:1
+6 SET FHPTNUM=$PIECE($GET(^FHPT(FHPTIEN,0)),U,1)
+7 SET FHIOFLD=$PIECE($GET(^FHPT(FHPTIEN,0)),U,2)
+8 IF FHPTNUM["N"
IF FHIOFLD'="O"
SET FHVAL="O"
DO UPD
QUIT
+9 SET FHDPTR=$EXTRACT(FHPTNUM,2,99)
IF FHDPTR=""
QUIT
+10 IF $DATA(^DPT(FHDPTR,.1))
SET FHVAL="I"
DO UPD
QUIT
End DoDot:1
+11 QUIT
UPD ;
+1 KILL DIE
SET DIE="^FHPT("
SET DA=FHPTIEN
+2 SET DR="13////^S X=FHVAL"
DO ^DIE
+3 QUIT
