- 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 Mar 13, 2025@20:57:50 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
