- FHOMPP1 ;Hines OIFO/RTK Patient Profile for CPRS (continued) ;6/07/04 9:05
- ;;5.5;DIETETICS;**1**;Jan 28, 2005
- ;
- S FHB="" F I=1:1:80 S FHB=FHB_" "
- S X1=STDT,X2=-1 D C^%DTC S STDT=X
- I '$O(^FHPT(FHDFN,"OP","B",STDT)) S N=1 D NEWL^FHOMPP S ^TMP($J,"FHPROF",DFN,FHX)="No Recurring Meals to Display" Q
- K FHLIST S EX="",NUM=0 D HDR
- F FHRMDT=STDT:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(EX=U) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0!(EX=U) D
- .S NUM=NUM+1,FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0))
- .S FHRM=$P(FHNODE,U,1)
- .S FHDOW=$$DOW^XLFDT(FHRM),FHDOW=$E(FHDOW,1,3)
- .S FHDTP=$$FMTE^XLFDT(FHRM,"P") S N=0 D NEWL^FHOMPP S ^TMP($J,"FHPROF",DFN,FHX)=NUM S FHJ=7 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_FHDOW_" - "_$E(FHDTP,1,12)
- .S FHLPT=$P(FHNODE,U,3),FHLOCZN=$G(^FH(119.6,FHLPT,0)) D
- ..S FHLOC=$E($P(FHLOCZN,U,1),1,10),FHSERV=$P(FHLOCZN,U,10)
- ..S FHSRV=$S(FHSERV["T":$P(FHLOCZN,U,5),FHSERV["C":$P(FHLOCZN,U,6),1:"")
- ..I FHSRV="" S FHSRVPT="" Q
- ..S FHSRVPT=$P($G(^FH(119.72,FHSRV,0)),U,1)
- ..Q
- .S FHJ=27 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_FHLOC
- .S FHJ=39 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_$E(FHSRVPT,1,9)
- .S FHJ=52 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_$P(FHNODE,U,4)
- .S FHJ=57 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_$P(FHNODE,U,5)
- .I $P($G(^FH(119.6,FHLPT,1)),U,4)="Y" D DIETPAT S FHJ=61 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_$E(FHDIETP,1,12)
- .E S FHDPTR=$P(FHNODE,U,2) S FHJ=61 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_$E($P($G(^FH(111,FHDPTR,0)),U,1),1,12)
- .S FHSTAT=$P(FHNODE,U,15) I FHSTAT="C" S FHJ=77 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_"C"
- .I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D
- ..S N=0 D NEWL^FHOMPP
- ..S FHNODE1=$G(^FHPT(FHDFN,"OP",FHRNUM,1))
- ..S FHSTATA=$P(FHNODE1,U,5) I FHSTATA="C" S ^TMP($J,"FHPROF",DFN,FHX)=" Additional Orders: "_$E($P(FHNODE1,U,1),1,46) S FHJ=77 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_"C" Q
- ..S ^TMP($J,"FHPROF",DFN,FHX)=" Additional Orders: "_$P(FHNODE1,U,1)
- .I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
- ..S N=0 D NEWL^FHOMPP
- ..S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2))
- ..S FHEL=FHNODE2
- ..S ^TMP($J,"FHPROF",DFN,FHX)=" Early/Late Tray Time: "_$P(FHEL,U,1)_" Bagged Meal: "_$P(FHEL,U,2)
- ..S FHSTATE=$P(FHNODE2,U,6) I FHSTATE="C" S FHJ=77 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_"C" Q
- .I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
- ..S N=0 D NEWL^FHOMPP
- ..S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3))
- ..S FHTU=FHNODE3
- ..S ^TMP($J,"FHPROF",DFN,FHX)=" Tubefeeding: " S FHSTATT=$P(FHTU,U,5) I FHSTATT="C" S FHJ=77 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_"C"
- ..S N=0 D NEWL^FHOMPP
- ..F FHTZ=0:0 S FHTZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ)) Q:FHTZ'>0 D
- ...S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
- ...S FHTUPTR=$P(FHTUZN,U,1),FHTUSTR=$P(FHTUZN,U,2)
- ...I $P(FHTUZN,U,3)["CC" D
- ....S QUA=$P(FHTUZN,U,3)
- ....S QUAFI=$P(QUA,"CC",1),QUASE=$P(QUA,"CC",2)
- ....S $P(FHTUZN,U,3)=QUAFI_"ML"_QUASE
- ...S ^TMP($J,"FHPROF",DFN,FHX)=" "_$P($G(^FH(118.2,FHTUPTR,0)),U,1)_" Strength: "_$S(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")_" Quantity: "_$P(FHTUZN,U,3)
- ...S N=0 D NEWL^FHOMPP
- ...S ^TMP($J,"FHPROF",DFN,FHX)=" Total ML's: "_$P(FHTU,U,2)_" Total KCALS/DAY: "_$P(FHTU,U,3)
- ..S FHTCOMM=$P(FHTU,U,1) I FHTCOMM'="" S N=0 D NEWL^FHOMPP S ^TMP($J,"FHPROF",DFN,FHX)="Comment: "_FHTCOMM
- .Q
- Q
- DIETPAT ;
- S FHDIETS=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
- S FHDIETP=""
- F PCE=1:1:5 D
- .S FHDPTR=$P(FHDIETS,U,PCE) I FHDPTR="" Q
- .S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,7)
- .I FHDNM="" S FHDNM=$P($G(^FH(111,FHDPTR,0)),U,1)
- .S FHDIETP=FHDIETP_FHDNM_"," Q
- S FHDIETP=$E(FHDIETP,1,$L(FHDIETP)-1)
- Q
- HDR ;
- ;S ^TMP($J,"FHPROF",DFN,FHX)=" OUTPATIENT NAME: " D PATNAME^FHOMUTL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_FHPTNM_" "_FHSSN
- ;S FHJ=66 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_FHSEX_" Age "_FHAGE
- S N=1 D NEWL^FHOMPP
- S ^TMP($J,"FHPROF",DFN,FHX)=" Ordering Service"
- S N=0 D NEWL^FHOMPP
- S ^TMP($J,"FHPROF",DFN,FHX)=" # Date/Time Location Point Meal Bag Diet Ordered Status"
- S N=0 D NEWL^FHOMPP
- S ^TMP($J,"FHPROF",DFN,FHX)="=== ================== ========== ========== ==== === ============ ======"
- Q
- PAD ;
- S FHU=^TMP($J,"FHPROF",DFN,FHX),A=$L(FHU),PAD=$E(FHB,1,FHJ-A)
- Q
- END ;
- K EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM
- K FHRNUM,FHDPTR,FHDNM Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMPP1 4784 printed Feb 18, 2025@23:19:12 Page 2
- FHOMPP1 ;Hines OIFO/RTK Patient Profile for CPRS (continued) ;6/07/04 9:05
- +1 ;;5.5;DIETETICS;**1**;Jan 28, 2005
- +2 ;
- +3 SET FHB=""
- FOR I=1:1:80
- SET FHB=FHB_" "
- +4 SET X1=STDT
- SET X2=-1
- DO C^%DTC
- SET STDT=X
- +5 IF '$ORDER(^FHPT(FHDFN,"OP","B",STDT))
- SET N=1
- DO NEWL^FHOMPP
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="No Recurring Meals to Display"
- QUIT
- +6 KILL FHLIST
- SET EX=""
- SET NUM=0
- DO HDR
- +7 FOR FHRMDT=STDT:0
- SET FHRMDT=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT))
- if FHRMDT'>0!(EX=U)
- QUIT
- FOR FHRNUM=0:0
- SET FHRNUM=$ORDER(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM))
- if FHRNUM'>0!(EX=U)
- QUIT
- Begin DoDot:1
- +8 SET NUM=NUM+1
- SET FHNODE=$GET(^FHPT(FHDFN,"OP",FHRNUM,0))
- +9 SET FHRM=$PIECE(FHNODE,U,1)
- +10 SET FHDOW=$$DOW^XLFDT(FHRM)
- SET FHDOW=$EXTRACT(FHDOW,1,3)
- +11 SET FHDTP=$$FMTE^XLFDT(FHRM,"P")
- SET N=0
- DO NEWL^FHOMPP
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=NUM
- SET FHJ=7
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_FHDOW_" - "_$EXTRACT(FHDTP,1,12)
- +12 SET FHLPT=$PIECE(FHNODE,U,3)
- SET FHLOCZN=$GET(^FH(119.6,FHLPT,0))
- Begin DoDot:2
- +13 SET FHLOC=$EXTRACT($PIECE(FHLOCZN,U,1),1,10)
- SET FHSERV=$PIECE(FHLOCZN,U,10)
- +14 SET FHSRV=$SELECT(FHSERV["T":$PIECE(FHLOCZN,U,5),FHSERV["C":$PIECE(FHLOCZN,U,6),1:"")
- +15 IF FHSRV=""
- SET FHSRVPT=""
- QUIT
- +16 SET FHSRVPT=$PIECE($GET(^FH(119.72,FHSRV,0)),U,1)
- +17 QUIT
- End DoDot:2
- +18 SET FHJ=27
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_FHLOC
- +19 SET FHJ=39
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_$EXTRACT(FHSRVPT,1,9)
- +20 SET FHJ=52
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_$PIECE(FHNODE,U,4)
- +21 SET FHJ=57
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_$PIECE(FHNODE,U,5)
- +22 IF $PIECE($GET(^FH(119.6,FHLPT,1)),U,4)="Y"
- DO DIETPAT
- SET FHJ=61
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_$EXTRACT(FHDIETP,1,12)
- +23 IF '$TEST
- SET FHDPTR=$PIECE(FHNODE,U,2)
- SET FHJ=61
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_$EXTRACT($PIECE($GET(^FH(111,FHDPTR,0)),U,1),1,12)
- +24 SET FHSTAT=$PIECE(FHNODE,U,15)
- IF FHSTAT="C"
- SET FHJ=77
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_"C"
- +25 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,1))
- Begin DoDot:2
- +26 SET N=0
- DO NEWL^FHOMPP
- +27 SET FHNODE1=$GET(^FHPT(FHDFN,"OP",FHRNUM,1))
- +28 SET FHSTATA=$PIECE(FHNODE1,U,5)
- IF FHSTATA="C"
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Additional Orders: "_$EXTRACT($PIECE(FHNODE1,U,1),1,46)
- SET FHJ=77
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_"C"
- QUIT
- +29 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Additional Orders: "_$PIECE(FHNODE1,U,1)
- End DoDot:2
- +30 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
- Begin DoDot:2
- +31 SET N=0
- DO NEWL^FHOMPP
- +32 SET FHNODE2=$GET(^FHPT(FHDFN,"OP",FHRNUM,2))
- +33 SET FHEL=FHNODE2
- +34 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Early/Late Tray Time: "_$PIECE(FHEL,U,1)_" Bagged Meal: "_$PIECE(FHEL,U,2)
- +35 SET FHSTATE=$PIECE(FHNODE2,U,6)
- IF FHSTATE="C"
- SET FHJ=77
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_"C"
- QUIT
- End DoDot:2
- +36 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
- Begin DoDot:2
- +37 SET N=0
- DO NEWL^FHOMPP
- +38 SET FHNODE3=$GET(^FHPT(FHDFN,"OP",FHRNUM,3))
- +39 SET FHTU=FHNODE3
- +40 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Tubefeeding: "
- SET FHSTATT=$PIECE(FHTU,U,5)
- IF FHSTATT="C"
- SET FHJ=77
- DO PAD
- SET ^TMP($JOB,"FHPROF",DFN,FHX)=^TMP($JOB,"FHPROF",DFN,FHX)_PAD_"C"
- +41 SET N=0
- DO NEWL^FHOMPP
- +42 FOR FHTZ=0:0
- SET FHTZ=$ORDER(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ))
- if FHTZ'>0
- QUIT
- Begin DoDot:3
- +43 SET FHTUZN=$GET(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHTZ,0))
- +44 SET FHTUPTR=$PIECE(FHTUZN,U,1)
- SET FHTUSTR=$PIECE(FHTUZN,U,2)
- +45 IF $PIECE(FHTUZN,U,3)["CC"
- Begin DoDot:4
- +46 SET QUA=$PIECE(FHTUZN,U,3)
- +47 SET QUAFI=$PIECE(QUA,"CC",1)
- SET QUASE=$PIECE(QUA,"CC",2)
- +48 SET $PIECE(FHTUZN,U,3)=QUAFI_"ML"_QUASE
- End DoDot:4
- +49 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" "_$PIECE($GET(^FH(118.2,FHTUPTR,0)),U,1)_" Strength: "_$SELECT(FHTUSTR=1:"1/4",FHTUSTR=2:"1/2",FHTUSTR=3:"3/4",1:"FULL")_" Quantity: "_$PIECE(FHTUZN,U,3)
- +50 SET N=0
- DO NEWL^FHOMPP
- +51 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Total ML's: "_$PIECE(FHTU,U,2)_" Total KCALS/DAY: "_$PIECE(FHTU,U,3)
- End DoDot:3
- +52 SET FHTCOMM=$PIECE(FHTU,U,1)
- IF FHTCOMM'=""
- SET N=0
- DO NEWL^FHOMPP
- SET ^TMP($JOB,"FHPROF",DFN,FHX)="Comment: "_FHTCOMM
- End DoDot:2
- +53 QUIT
- End DoDot:1
- +54 QUIT
- DIETPAT ;
- +1 SET FHDIETS=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,7,11)
- +2 SET FHDIETP=""
- +3 FOR PCE=1:1:5
- Begin DoDot:1
- +4 SET FHDPTR=$PIECE(FHDIETS,U,PCE)
- IF FHDPTR=""
- QUIT
- +5 SET FHDNM=$PIECE($GET(^FH(111,FHDPTR,0)),U,7)
- +6 IF FHDNM=""
- SET FHDNM=$PIECE($GET(^FH(111,FHDPTR,0)),U,1)
- +7 SET FHDIETP=FHDIETP_FHDNM_","
- QUIT
- End DoDot:1
- +8 SET FHDIETP=$EXTRACT(FHDIETP,1,$LENGTH(FHDIETP)-1)
- +9 QUIT
- HDR ;
- +1 ;S ^TMP($J,"FHPROF",DFN,FHX)=" OUTPATIENT NAME: " D PATNAME^FHOMUTL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_FHPTNM_" "_FHSSN
- +2 ;S FHJ=66 D PAD S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"FHPROF",DFN,FHX)_PAD_FHSEX_" Age "_FHAGE
- +3 SET N=1
- DO NEWL^FHOMPP
- +4 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" Ordering Service"
- +5 SET N=0
- DO NEWL^FHOMPP
- +6 SET ^TMP($JOB,"FHPROF",DFN,FHX)=" # Date/Time Location Point Meal Bag Diet Ordered Status"
- +7 SET N=0
- DO NEWL^FHOMPP
- +8 SET ^TMP($JOB,"FHPROF",DFN,FHX)="=== ================== ========== ========== ==== === ============ ======"
- +9 QUIT
- PAD ;
- +1 SET FHU=^TMP($JOB,"FHPROF",DFN,FHX)
- SET A=$LENGTH(FHU)
- SET PAD=$EXTRACT(FHB,1,FHJ-A)
- +2 QUIT
- END ;
- +1 KILL EX,FHDIET,FHDIETP,FHDIETS,FHDTP,FHFIND,FHLOC,FHLPT,FHNODE,FHRM
- +2 KILL FHRNUM,FHDPTR,FHDNM
- QUIT