FHORX.m

FHORX ; HISC/REL,RTK - File Dietetic Event ;2/26/96  09:54

 ;;5.5;DIETETICS;;Jan 28, 2005

FIL ; File event

 L +^FH(119.8,0) S DA=$P(^FH(119.8,0),"^",3)+1,$P(^FH(119.8,0),"^",3,4)=DA_"^"_DA L -^FH(119.8,0)

 I $D(^FH(119.8,DA)) G FIL

 I $G(ADM)="" S ADM=""  ;for outpatient food preferences - RTK 8/04

 D NOW^%DTC

 S ^FH(119.8,DA,0)=DA_"^"_%_"^"_FHDFN_"^"_ADM_"^"_EVT S $P(^(0),"^",9)=DUZ

 S ^FH(119.8,"B",DA,DA)="",^FH(119.8,"AP",FHDFN,%,DA)="",^FH(119.8,"AD",%,DA)=""

 K %,DA,EVT Q

OPFILE ; File outpatient events (TYPE = "Z")

 K DIC,DO S Y=$P(^FH(119.8,0),"^",3)+1,DIC="^FH(119.8,",X=+Y,DINUM=X

 S DIC(0)="L" D FILE^DICN I Y=-1 Q

 D NOW^%DTC S FHDTM=%,FHTYP="Z"

 K DIE S DIE="^FH(119.8,",DA=+Y

 S DR="1////^S X=FHDTM;2////^S X=FHDFN;4////^S X=FHTYP;5////^S X=FHACT;7////^S X=FHTXT;8////^S X=DUZ" D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHORX   824     printed  Apr 09, 2024@21:01:04                                                                                                                                                                                                        Page 2

FHORX     ; HISC/REL,RTK - File Dietetic Event ;2/26/96  09:54

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

FIL       ; File event

 +1        LOCK +^FH(119.8,0)

           SET DA=$PIECE(^FH(119.8,0),"^",3)+1

           SET $PIECE(^FH(119.8,0),"^",3,4)=DA_"^"_DA

           LOCK -^FH(119.8,0)

 +2        IF $DATA(^FH(119.8,DA))

               GOTO FIL

 +3       ;for outpatient food preferences - RTK 8/04

           IF $GET(ADM)=""

               SET ADM=""

 +4        DO NOW^%DTC

 +5        SET ^FH(119.8,DA,0)=DA_"^"_%_"^"_FHDFN_"^"_ADM_"^"_EVT

           SET $PIECE(^(0),"^",9)=DUZ

 +6        SET ^FH(119.8,"B",DA,DA)=""

           SET ^FH(119.8,"AP",FHDFN,%,DA)=""

           SET ^FH(119.8,"AD",%,DA)=""

 +7        KILL %,DA,EVT

           QUIT 

OPFILE    ; File outpatient events (TYPE = "Z")

 +1        KILL DIC,DO

           SET Y=$PIECE(^FH(119.8,0),"^",3)+1

           SET DIC="^FH(119.8,"

           SET X=+Y

           SET DINUM=X

 +2        SET DIC(0)="L"

           DO FILE^DICN

           IF Y=-1

               QUIT 

 +3        DO NOW^%DTC

           SET FHDTM=%

           SET FHTYP="Z"

 +4        KILL DIE

           SET DIE="^FH(119.8,"

           SET DA=+Y

 +5        SET DR="1////^S X=FHDTM;2////^S X=FHDFN;4////^S X=FHTYP;5////^S X=FHACT;7////^S X=FHTXT;8////^S X=DUZ"

           DO ^DIE

 +6        QUIT