FHDSSAPI ;Hines OIFO/RTK,JRC-DSS REQUESTED API's ; 11/3/08 2:42pm
;;5.5;DIETETICS;**7,11,10,16,18**;Jan 28, 2005;Build 27
;11/22/2006 KAM/BAY Remedy Call 168346 Add Variable Cleanup from *7
;03/31/2008 GDU/SLC Remedy 226373, inpatient record selection for extract re-worked
DATA(FHSDT,FHEDT) ;API for DSS extract of NFS data
; INPUT: START DATE, END DATE
; OUTPUT: ^TMP($J,"FH"
; Get inpatient meals
I FHSDT>FHEDT W !!,"END DATE BEFORE START DATE!",! H 1 Q
K ^TMP($J,"FH") S FHEDT=FHEDT_.99
F FHDFN=0:0 S FHDFN=$O(^FHPT(FHDFN)) Q:FHDFN'>0 D
. I '$D(^FHPT(FHDFN,0)) Q
. D PATNAME^FHOMUTL
. ;Check if patient is deceased. Quit if date of death is before start date
. S FHDCEASE=$$GET1^DIQ(2,DFN,".351","I")
. I FHDCEASE&(FHDCEASE<FHSDT) D CLEAN Q
. D INPAT,CLEAN
D OUTPAT
K FHADM,FHDATE,FHDFN,FHDSEQ,FHEL,FHNODE,FHNODE2,FHNODE3,FHOMDT,FHRNUM
K FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,FHZN
K FHCDATE,FHNUM,FHEFF,FHADTM,FHDDTM,FHLAST,X,X1,X2,FHDCEASE,FHSTOP
Q
CLEAN ;Clean up variables set by PATNAME^FHOMUTL
K BID,DFN,FHAGE,FHDOB,FHPCZN,FHPTNM,FHSEX,FHSSN,FILE,PID,IEN
Q
INPAT ;Process inpatient data
F FHADM=0:0 S FHADM=$O(^FHPT(FHDFN,"A",FHADM)) Q:FHADM'>0 D
.S FHZN=$G(^FHPT(FHDFN,"A",FHADM,0)),FHLAST="",FHSTOP=0
.S FHADTM=$P(FHZN,U,1) I $P(FHADTM,".")>FHEDT Q
.;If no discharge date, pull discharge date from registration pacakge for this admission
.;If no matching record in registration package for this admission continue to next admission record
.I '$P(FHZN,U,14) D I FHSTOP Q
.. S VAINDT=FHADTM
.. D INP^VADPT
.. I VAIN(1)="" D KVAR^VADPT S FHSTOP=1 Q
.. S VAIP("E")=VAIN(1),VAIP("M")=1
.. D IN5^VADPT
.. I +VAIP(2)=3 S $P(FHZN,U,14)=+VAIP(3)
.. D KVAR^VADPT
.;If no discharge date, set to date of death if patient is deceased
.I '$P(FHZN,U,14),FHDCEASE S $P(FHZN,U,14)=FHDCEASE
.S FHDDTM=$P(FHZN,U,14) I FHDDTM'="",FHDDTM<FHSDT Q
.F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT) D
..S FHDSEQ=$P($G(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
..I $P(FHNODE,U,18)="",$P(FHZN,U,14)'="" S $P(FHNODE,U,18)=$P(FHZN,U,14)
..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"INP")
..S FHLAST=FHDATE
..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"INP")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
.; Get additional feedings for inpatient
.; Get Early/Late trays
.F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT) D
..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE,0))
..I FHDATE<FHSDT Q I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"EL")
..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"EL")=FHNODE
.;Get Supplemental Feedings
.S FHLAST="" F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"A",FHADM,"SF",FHSF)) Q:FHSF'>0 D
..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0))
..I $P(FHNODE,U,32)="",$P(FHZN,U,14)'="" S $P(FHNODE,U,32)=$P(FHZN,U,14)
..S FHDATE=$P(FHNODE,U,2) I FHDATE>FHEDT Q
..S FHCDATE=$P(FHNODE,U,32) I FHCDATE'="" I FHCDATE<FHSDT Q
..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"SF")
..S FHLAST=FHDATE
..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SF")=FHNODE
.;Get Standing Orders
.S FHNUM=0 F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"A",FHADM,"SP",FHSO)) Q:FHSO'>0 D
..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0))
..I $P(FHNODE,U,6)="",$P(FHZN,U,14)'="" S $P(FHNODE,U,6)=$P(FHZN,U,14)
..S FHDATE=$P(FHNODE,U,4) I FHDATE>FHEDT Q
..S FHCDATE=$P(FHNODE,U,6) I FHCDATE'="" I FHCDATE<FHSDT Q
..S FHNUM=FHNUM+1,^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SO",FHNUM)=FHNODE
.;Get Tube Feedings
.S FHLAST="" F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF)) Q:FHTF'>0 D
..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0))
..I $P(FHNODE,U,11)="",$P(FHZN,U,14)'="" S $P(FHNODE,U,11)=$P(FHZN,U,14)
..S FHDATE=$P(FHNODE,U,1) I FHDATE>FHEDT Q
..S FHCDATE=$P(FHNODE,U,11) I FHCDATE'="" I FHCDATE<FHSDT Q
..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"TF")
..S FHLAST=FHDATE
..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF")=FHNODE
..F FHTFPR=0:0 S FHTFPR=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR)) Q:FHTFPR'>0 D
...S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR,0))
...S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF",FHTFPR,"P")=FHNODE
...Q
..Q
.Q
Q
;
OUTPAT ;Process outpatient data
; Get outpatient meals
S X1=FHSDT,X2=-1 D C^%DTC S FHSDTX1=X_.99
; Get recurring meals
F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN="" D
..I '$D(^FHPT(FHDFN,0)) Q
..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM="" D
...S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0)) I $P(FHNODE,U,15)="C" Q
...I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
...S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
...;
...; IF NON-VA LOC DIET(S) ARE IN FIELDS DIET1-DIET5
...;
...I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
....S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2)) I $P(FHNODE2,U,6)="C" Q
....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMEL")=FHNODE2 I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
...I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
....S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3)) I $P(FHNODE3,U,5)="C" Q
....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF")=FHNODE3 I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
....F FHZ=0:0 S FHZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ)) Q:FHZ'>0 D
.....S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ,0))
.....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF",FHZ)=FHTUZN I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
...;fh*5.5*18
...;adding supplemental feedings for outpatient
...I $D(^FHPT(FHDFN,"OP",FHRNUM,"SF")) D
....S FHLAST="" F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"OP",FHRNUM,"SF",FHSF)) Q:FHSF'>0 D
.....S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,"SF",FHSF,0))
.....S FHDATE=$P(FHNODE,U,2) I FHDATE>FHEDT Q
.....S FHCDATE=$P(FHNODE,U,32) I FHCDATE'="" I FHCDATE<FHSDT Q
.....I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"SF")
.....S FHLAST=FHDATE
.....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMSF")=FHNODE
...;adding standing orders for outpatient
...S FHNUM=0 F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHSO)) Q:FHSO'>0 D
....S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHSO,0))
....S FHDATE=$P(FHNODE,U,4) I FHDATE>FHEDT Q
....S FHCDATE=$P(FHNODE,U,6) I FHCDATE'="" I FHCDATE<FHSDT Q
....S FHNUM=FHNUM+1,^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMSO",FHNUM)=FHNODE
; Get special meals
F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN="" D
..I '$D(^FHPT(FHDFN,0)) Q
..S FHNODE=$G(^FHPT(FHDFN,"SM",FHOMDT,0)) I $P(FHNODE,U,2)'="A" Q
..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
..S ^TMP($J,"FH",FHOMDT,FHDFN,"SM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
; Get guest meals
F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN="" D
..I '$D(^FHPT(FHDFN,0)) Q
..S FHNODE=$G(^FHPT(FHDFN,"GM",FHOMDT,0)) I $P(FHNODE,U,9)="C" Q
..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
..S ^TMP($J,"FH",FHOMDT,FHDFN,"GM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDSSAPI 7670 printed Apr 09, 2024@20:54:48 Page 2
FHDSSAPI ;Hines OIFO/RTK,JRC-DSS REQUESTED API's ; 11/3/08 2:42pm
+1 ;;5.5;DIETETICS;**7,11,10,16,18**;Jan 28, 2005;Build 27
+2 ;11/22/2006 KAM/BAY Remedy Call 168346 Add Variable Cleanup from *7
+3 ;03/31/2008 GDU/SLC Remedy 226373, inpatient record selection for extract re-worked
DATA(FHSDT,FHEDT) ;API for DSS extract of NFS data
+1 ; INPUT: START DATE, END DATE
+2 ; OUTPUT: ^TMP($J,"FH"
+3 ; Get inpatient meals
+4 IF FHSDT>FHEDT
WRITE !!,"END DATE BEFORE START DATE!",!
HANG 1
QUIT
+5 KILL ^TMP($JOB,"FH")
SET FHEDT=FHEDT_.99
+6 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT(FHDFN))
if FHDFN'>0
QUIT
Begin DoDot:1
+7 IF '$DATA(^FHPT(FHDFN,0))
QUIT
+8 DO PATNAME^FHOMUTL
+9 ;Check if patient is deceased. Quit if date of death is before start date
+10 SET FHDCEASE=$$GET1^DIQ(2,DFN,".351","I")
+11 IF FHDCEASE&(FHDCEASE<FHSDT)
DO CLEAN
QUIT
+12 DO INPAT
DO CLEAN
End DoDot:1
+13 DO OUTPAT
+14 KILL FHADM,FHDATE,FHDFN,FHDSEQ,FHEL,FHNODE,FHNODE2,FHNODE3,FHOMDT,FHRNUM
+15 KILL FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,FHZN
+16 KILL FHCDATE,FHNUM,FHEFF,FHADTM,FHDDTM,FHLAST,X,X1,X2,FHDCEASE,FHSTOP
+17 QUIT
CLEAN ;Clean up variables set by PATNAME^FHOMUTL
+1 KILL BID,DFN,FHAGE,FHDOB,FHPCZN,FHPTNM,FHSEX,FHSSN,FILE,PID,IEN
+2 QUIT
INPAT ;Process inpatient data
+1 FOR FHADM=0:0
SET FHADM=$ORDER(^FHPT(FHDFN,"A",FHADM))
if FHADM'>0
QUIT
Begin DoDot:1
+2 SET FHZN=$GET(^FHPT(FHDFN,"A",FHADM,0))
SET FHLAST=""
SET FHSTOP=0
+3 SET FHADTM=$PIECE(FHZN,U,1)
IF $PIECE(FHADTM,".")>FHEDT
QUIT
+4 ;If no discharge date, pull discharge date from registration pacakge for this admission
+5 ;If no matching record in registration package for this admission continue to next admission record
+6 IF '$PIECE(FHZN,U,14)
Begin DoDot:2
+7 SET VAINDT=FHADTM
+8 DO INP^VADPT
+9 IF VAIN(1)=""
DO KVAR^VADPT
SET FHSTOP=1
QUIT
+10 SET VAIP("E")=VAIN(1)
SET VAIP("M")=1
+11 DO IN5^VADPT
+12 IF +VAIP(2)=3
SET $PIECE(FHZN,U,14)=+VAIP(3)
+13 DO KVAR^VADPT
End DoDot:2
IF FHSTOP
QUIT
+14 ;If no discharge date, set to date of death if patient is deceased
+15 IF '$PIECE(FHZN,U,14)
IF FHDCEASE
SET $PIECE(FHZN,U,14)=FHDCEASE
+16 SET FHDDTM=$PIECE(FHZN,U,14)
IF FHDDTM'=""
IF FHDDTM<FHSDT
QUIT
+17 FOR FHDATE=0:0
SET FHDATE=$ORDER(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE))
if FHDATE'>0!(FHDATE>FHEDT)
QUIT
Begin DoDot:2
+18 SET FHDSEQ=$PIECE($GET(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
+19 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
+20 IF $PIECE(FHNODE,U,18)=""
IF $PIECE(FHZN,U,14)'=""
SET $PIECE(FHNODE,U,18)=$PIECE(FHZN,U,14)
+21 IF FHDATE<FHSDT
IF FHLAST'=""
KILL ^TMP($JOB,"FH",FHADM,FHDFN,FHLAST,"INP")
+22 SET FHLAST=FHDATE
+23 SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"INP")=FHNODE
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
End DoDot:2
+24 ; Get additional feedings for inpatient
+25 ; Get Early/Late trays
+26 FOR FHDATE=0:0
SET FHDATE=$ORDER(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE))
if FHDATE'>0!(FHDATE>FHEDT)
QUIT
Begin DoDot:2
+27 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE,0))
+28 IF FHDATE<FHSDT
QUIT
IF FHLAST'=""
KILL ^TMP($JOB,"FH",FHADM,FHDFN,FHLAST,"EL")
+29 SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"EL")=FHNODE
End DoDot:2
+30 ;Get Supplemental Feedings
+31 SET FHLAST=""
FOR FHSF=0:0
SET FHSF=$ORDER(^FHPT(FHDFN,"A",FHADM,"SF",FHSF))
if FHSF'>0
QUIT
Begin DoDot:2
+32 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0))
+33 IF $PIECE(FHNODE,U,32)=""
IF $PIECE(FHZN,U,14)'=""
SET $PIECE(FHNODE,U,32)=$PIECE(FHZN,U,14)
+34 SET FHDATE=$PIECE(FHNODE,U,2)
IF FHDATE>FHEDT
QUIT
+35 SET FHCDATE=$PIECE(FHNODE,U,32)
IF FHCDATE'=""
IF FHCDATE<FHSDT
QUIT
+36 IF FHDATE<FHSDT
IF FHLAST'=""
KILL ^TMP($JOB,"FH",FHADM,FHDFN,FHLAST,"SF")
+37 SET FHLAST=FHDATE
+38 SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"SF")=FHNODE
End DoDot:2
+39 ;Get Standing Orders
+40 SET FHNUM=0
FOR FHSO=0:0
SET FHSO=$ORDER(^FHPT(FHDFN,"A",FHADM,"SP",FHSO))
if FHSO'>0
QUIT
Begin DoDot:2
+41 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0))
+42 IF $PIECE(FHNODE,U,6)=""
IF $PIECE(FHZN,U,14)'=""
SET $PIECE(FHNODE,U,6)=$PIECE(FHZN,U,14)
+43 SET FHDATE=$PIECE(FHNODE,U,4)
IF FHDATE>FHEDT
QUIT
+44 SET FHCDATE=$PIECE(FHNODE,U,6)
IF FHCDATE'=""
IF FHCDATE<FHSDT
QUIT
+45 SET FHNUM=FHNUM+1
SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"SO",FHNUM)=FHNODE
End DoDot:2
+46 ;Get Tube Feedings
+47 SET FHLAST=""
FOR FHTF=0:0
SET FHTF=$ORDER(^FHPT(FHDFN,"A",FHADM,"TF",FHTF))
if FHTF'>0
QUIT
Begin DoDot:2
+48 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0))
+49 IF $PIECE(FHNODE,U,11)=""
IF $PIECE(FHZN,U,14)'=""
SET $PIECE(FHNODE,U,11)=$PIECE(FHZN,U,14)
+50 SET FHDATE=$PIECE(FHNODE,U,1)
IF FHDATE>FHEDT
QUIT
+51 SET FHCDATE=$PIECE(FHNODE,U,11)
IF FHCDATE'=""
IF FHCDATE<FHSDT
QUIT
+52 IF FHDATE<FHSDT
IF FHLAST'=""
KILL ^TMP($JOB,"FH",FHADM,FHDFN,FHLAST,"TF")
+53 SET FHLAST=FHDATE
+54 SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"TF")=FHNODE
+55 FOR FHTFPR=0:0
SET FHTFPR=$ORDER(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR))
if FHTFPR'>0
QUIT
Begin DoDot:3
+56 SET FHNODE=$GET(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR,0))
+57 SET ^TMP($JOB,"FH",FHADM,FHDFN,FHDATE,"TF",FHTFPR,"P")=FHNODE
+58 QUIT
End DoDot:3
+59 QUIT
End DoDot:2
+60 QUIT
End DoDot:1
+61 QUIT
+62 ;
OUTPAT ;Process outpatient data
+1 ; Get outpatient meals
+2 SET X1=FHSDT
SET X2=-1
DO C^%DTC
SET FHSDTX1=X_.99
+3 ; Get recurring meals
+4 FOR FHOMDT=FHSDTX1:0
SET FHOMDT=$ORDER(^FHPT("RM",FHOMDT))
if FHOMDT=""!(FHOMDT'<FHEDT)
QUIT
Begin DoDot:1
+5 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("RM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+6 IF '$DATA(^FHPT(FHDFN,0))
QUIT
+7 FOR FHRNUM=0:0
SET FHRNUM=$ORDER(^FHPT("RM",FHOMDT,FHDFN,FHRNUM))
if FHRNUM=""
QUIT
Begin DoDot:3
+8 SET FHNODE=$GET(^FHPT(FHDFN,"OP",FHRNUM,0))
IF $PIECE(FHNODE,U,15)="C"
QUIT
+9 IF $PIECE($GET(^FHPT(FHDFN,0)),U,3)=""
QUIT
+10 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RM")=FHNODE
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+11 ;
+12 ; IF NON-VA LOC DIET(S) ARE IN FIELDS DIET1-DIET5
+13 ;
+14 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
Begin DoDot:4
+15 SET FHNODE2=$GET(^FHPT(FHDFN,"OP",FHRNUM,2))
IF $PIECE(FHNODE2,U,6)="C"
QUIT
+16 IF $PIECE($GET(^FHPT(FHDFN,0)),U,3)=""
QUIT
+17 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RMEL")=FHNODE2
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
End DoDot:4
+18 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
Begin DoDot:4
+19 SET FHNODE3=$GET(^FHPT(FHDFN,"OP",FHRNUM,3))
IF $PIECE(FHNODE3,U,5)="C"
QUIT
+20 IF $PIECE($GET(^FHPT(FHDFN,0)),U,3)=""
QUIT
+21 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF")=FHNODE3
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+22 FOR FHZ=0:0
SET FHZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ))
if FHZ'>0
QUIT
Begin DoDot:5
+23 SET FHTUZN=$GET(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ,0))
+24 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF",FHZ)=FHTUZN
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
End DoDot:5
End DoDot:4
+25 ;fh*5.5*18
+26 ;adding supplemental feedings for outpatient
+27 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,"SF"))
Begin DoDot:4
+28 SET FHLAST=""
FOR FHSF=0:0
SET FHSF=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"SF",FHSF))
if FHSF'>0
QUIT
Begin DoDot:5
+29 SET FHNODE=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SF",FHSF,0))
+30 SET FHDATE=$PIECE(FHNODE,U,2)
IF FHDATE>FHEDT
QUIT
+31 SET FHCDATE=$PIECE(FHNODE,U,32)
IF FHCDATE'=""
IF FHCDATE<FHSDT
QUIT
+32 IF FHDATE<FHSDT
IF FHLAST'=""
KILL ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"SF")
+33 SET FHLAST=FHDATE
+34 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RMSF")=FHNODE
End DoDot:5
End DoDot:4
+35 ;adding standing orders for outpatient
+36 SET FHNUM=0
FOR FHSO=0:0
SET FHSO=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHSO))
if FHSO'>0
QUIT
Begin DoDot:4
+37 SET FHNODE=$GET(^FHPT(FHDFN,"OP",FHRNUM,"SP",FHSO,0))
+38 SET FHDATE=$PIECE(FHNODE,U,4)
IF FHDATE>FHEDT
QUIT
+39 SET FHCDATE=$PIECE(FHNODE,U,6)
IF FHCDATE'=""
IF FHCDATE<FHSDT
QUIT
+40 SET FHNUM=FHNUM+1
SET ^TMP($JOB,"FH",FHOMDT,FHDFN,FHRNUM,"RMSO",FHNUM)=FHNODE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ; Get special meals
+42 FOR FHOMDT=FHSDTX1:0
SET FHOMDT=$ORDER(^FHPT("SM",FHOMDT))
if FHOMDT=""!(FHOMDT'<FHEDT)
QUIT
Begin DoDot:1
+43 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("SM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+44 IF '$DATA(^FHPT(FHDFN,0))
QUIT
+45 SET FHNODE=$GET(^FHPT(FHDFN,"SM",FHOMDT,0))
IF $PIECE(FHNODE,U,2)'="A"
QUIT
+46 IF $PIECE($GET(^FHPT(FHDFN,0)),U,3)=""
QUIT
+47 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,"SM")=FHNODE
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
End DoDot:2
End DoDot:1
+48 ; Get guest meals
+49 FOR FHOMDT=FHSDTX1:0
SET FHOMDT=$ORDER(^FHPT("GM",FHOMDT))
if FHOMDT=""!(FHOMDT'<FHEDT)
QUIT
Begin DoDot:1
+50 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("GM",FHOMDT,FHDFN))
if FHDFN=""
QUIT
Begin DoDot:2
+51 IF '$DATA(^FHPT(FHDFN,0))
QUIT
+52 SET FHNODE=$GET(^FHPT(FHDFN,"GM",FHOMDT,0))
IF $PIECE(FHNODE,U,9)="C"
QUIT
+53 IF $PIECE($GET(^FHPT(FHDFN,0)),U,3)=""
QUIT
+54 SET ^TMP($JOB,"FH",FHOMDT,FHDFN,"GM")=FHNODE
IF '$DATA(^TMP($JOB,"FH","ZN",FHDFN))
SET ^TMP($JOB,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
End DoDot:2
End DoDot:1
+55 QUIT
