FHOMUPD.m

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 ---FHOMUPD   489     printed  Apr 09, 2024@20:58:29                                                                                                                                                                                                      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