- 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 Feb 18, 2025@23:14:03 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
