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 ---[H[J[2J[HFHORX 824 printed Dec 13, 2024@01:54:02 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
