FHOMRBL1 ;Hines OIFO/RVD-OUTPATIENT REPORT UTILITY2 ;2/03/04 10:05
;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
;
;PATCH #5 - added the cancelled guest meal status and a screen for cancelled meals.
;
GETGM(FHGDT,FHGCOM,FHGLOC,FHGDFN) ;get guest meals data
;ENTRY POINTS:
; GETGM - get outpatient guest meals data from starting dt.
;input variable:
; FHGDT = starting date
; FHGCOM = IEN of communication office, 'ALL' for all.
; = if NULL, considered 'ALL'
; FHGLOC = IEN of location, 'ALL' for all.
; = if NULL, considered 'ALL'
; FHGDFN = IEN of file #115, 'ALL' for all.
; = if NULL, considered 'ALL'
;
;output variable:
; ^TMP($J,"OP","G",COMM OFF,PATIENT NAME,DTE)
;
;error:
; ^TMP($J,"OP","ER")
K ^TMP($J,"OP","G")
D NEWVAR
S:FHGDFN="" FHGDFN="ALL"
S:FHGCOM="" FHGCOM="ALL"
S:FHGLOC="" FHGLOC="ALL"
S FHGDT=FHGDT-.000001
I '$O(^FHPT("GM",FHGDT)) S ^TMP($J,"OP","ER")="NO GUEST MEALS FOR THIS DATE RANGE" Q
;
F FHGMDT=FHGDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0 D
.F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0 D
..I $G(FHGDFN),(FHGDFN'=FHDFN) Q
..S (FHGCOMN,FHPTNM,FHLOCN)=""
..S FHNODE=$G(^FHPT(FHDFN,"GM",FHGMDT,0))
..S FHCL=$P(FHNODE,U,2)
..S FHML=$P(FHNODE,U,3)
..S FHCH=$P(FHNODE,U,4)
..S FHLPT=$P(FHNODE,U,5)
..S FHDIET=$P(FHNODE,U,6)
..S FHSTAT=$P(FHNODE,U,9)
..I $G(FHGLOC),FHGLOC'=FHLPT Q ;quit if location is not the same
..S:$G(FHLPT) FHLCOM=$P($G(^FH(119.6,FHLPT,0)),U,8)
..I $G(FHGCOM),FHGCOM'=FHLCOM Q ;quit if d same communication office
..S:$G(FHLCOM) FHGCOMN=$P($G(^FH(119.73,FHLCOM,0)),U,1)
..S:FHGCOMN="" FHGCOMN="***"
..I $G(FHLPT) D
...S FHLOCN=$P($G(^FH(119.6,FHLPT,0)),U,1)
..S:FHLOCN="" FHLOCN="***"
..;
..S FHCL=$S(FHCL="E":"EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOLUNTEER")
..S FHD=$$FMTE^XLFDT(FHGMDT,"P")
..S FHD=$E(FHD,1,12)
..D PATNAME^FHOMUTL S FHPTNM=$E(FHPTNM,1,24)
..S:FHPTNM="" FHPTNM="***"
..S ^TMP($J,"OP","G",FHGCOMN,FHLOCN,FHPTNM,FHGMDT)=FHDFN_"^"_FHD_"^"_FHML_"^"_FHCL_"^"_FHCH_"^"_FHDIET_"^"_FHSTAT
Q
;
NEWVAR ;new all variables.
N FHPTNM,FHD,FHDIET,FHMEAL,FHELTT,FHELBG,FHDAT,FHSTAT,FHLPT
N FHAGE,FHCH,FHCL,FHDOB,FHGMDT,FHML,FHNODE,FHPCZN,FHSEX,FHSSN,FILE
N FHDAT,FHDPT,FHEL,FHLPT,FHS,FHSMDT,FHSTAT,FHNN,FH
Q
;
GETOUT ;get outpatient data for TODAY.
;output variables:
; ^TMP($J,"FH",##LOCATION,PATIENT NAME,DATE)=OP or SM or GM^IEN OF 115^MEAL^
;
K ^TMP($J)
N FHMEAL,FHDT,DT3,FHI,I,J,FHRMD,FHRMLNM,FHSMD,FHSMSTA,DFN,FHDFN
N DTTST,FHSMLNM,FHGMLNM
;recurring meals
S FHDT=DT-.00001,DT3=DT+.999999
F FHI=FHDT:0 S FHI=$O(^FHPT("RM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("RM",FHI,I)) Q:I'>0 D
.F J=0:0 S J=$O(^FHPT("RM",FHI,I,J)) Q:J'>0 D
..S (FHRMD,FHMEAL)=""
..S FHRMLNM="***"
..I $D(^FHPT(I,"OP",J,0)) S FHRMD=$G(^FHPT(I,"OP",J,0))
..Q:$P(FHRMD,U,15)="C"
..I $D(FHRMD) S FHMEAL=$P(FHRMD,U,2)
..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
..S:FHMEAL="" FHMEAL=$P(FHRMD,U,7)
..S:FHMEAL="" FHMEAL=$P(FHRMD,U,8)
..S:FHMEAL="" FHMEAL=$P(FHRMD,U,9)
..S:FHMEAL="" FHMEAL=$P(FHRMD,U,10)
..S:FHMEAL="" FHMEAL=$P(FHRMD,U,11)
..S FHRMLOC=$P(FHRMD,U,3) Q:FHRMLOC=""
..S FHML=$P(FHRMD,U,4)
..I $G(FHRMLOC),$D(^FH(119.6,FHRMLOC,0)) D
...S FHRMLNM=$P(^FH(119.6,FHRMLOC,0),U,1)
...S FHRMPR=$P(^FH(119.6,FHRMLOC,0),U,4)
...S FHRMSTA=$P(^FH(119.6,FHRMLOC,0),U,8)
...S:FHRMPR<10 FHRMPR=0_FHRMPR
...S:FHRMPR="" FHRMPR=99
..S ^TMP($J,"FH",FHRMPR_FHRMLNM,FHPTNM,FHI,J)="OP"_"^"_I_"^"_FHMEAL_"^"_FHRMSTA_"^"_FHML_"^"_FHRMLOC_"^"_J
SM ;special meals
S FHDT=DT-.00001,DTTST=$P(DT,".",1),DT3=DTTST+1
F FHI=FHDT:0 S FHI=$O(^FHPT("SM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("SM",FHI,I)) Q:I'>0 D
.F J=0:0 S J=$O(^FHPT("SM",FHI,I,J)) Q:J'>0 D
..S (FHSMD,FHMEAL)=""
..S FHSMSTA=""
..I $D(^FHPT(I,"SM",J,0)) S FHSMD=$G(^FHPT(I,"SM",J,0))
..Q:$P(FHSMD,U,2)'="A"
..I $D(FHSMD) S FHMEAL=$P(FHSMD,U,4)
..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
..S FHSMLOC=$P(FHSMD,U,3) Q:FHSMLOC=""
..S FHSMSTA=$P(FHSMD,U,2)
..S FHML=$P(FHSMD,U,9)
..I $G(FHSMLOC),$D(^FH(119.6,FHSMLOC,0)) D
...S FHSMLNM=$P(^FH(119.6,FHSMLOC,0),U,1)
...S FHSMPR=$P(^FH(119.6,FHSMLOC,0),U,4)
...S FHSMSTA=$P(^FH(119.6,FHSMLOC,0),U,8)
...S:FHSMPR<10 FHSMPR=0_FHSMPR
...S:FHSMPR="" FHSMPR=99
..S ^TMP($J,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="SM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
;guest meals
S FHDT=DT-.00001,DTTST=$P(DT,".",1),DT3=DTTST+1
F FHI=FHDT:0 S FHI=$O(^FHPT("GM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("GM",FHI,I)) Q:I'>0 D
.F J=0:0 S J=$O(^FHPT("GM",FHI,I,J)) Q:J'>0 D
..S (FHSMD,FHMEAL)=""
..S FHSMSTA=""
..S FHSMLNM="***"
..I $D(^FHPT(I,"GM",J,0)) S FHSMD=$G(^FHPT(I,"GM",J,0))
..Q:$P(FHSMD,U,9)="C"
..I $D(FHSMD) S FHMEAL=$P(FHSMD,U,6)
..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
..S FHSMLOC=$P(FHSMD,U,5) Q:FHSMLOC=""
..S FHML=$P(FHSMD,U,3)
..I $G(FHSMLOC),$D(^FH(119.6,FHSMLOC,0)) D
...S FHSMLNM=$P(^FH(119.6,FHSMLOC,0),U,1)
...S FHSMSTA=$P(^FH(119.6,FHSMLOC,0),U,8)
...S FHSMPR=$P(^FH(119.6,FHSMLOC,0),U,4)
...S:FHSMPR<10 FHSMPR=0_FHSMPR
...S:FHSMPR="" FHSMPR=99
..S ^TMP($J,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="GM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRBL1 5475 printed Nov 22, 2024@17:03:02 Page 2
FHOMRBL1 ;Hines OIFO/RVD-OUTPATIENT REPORT UTILITY2 ;2/03/04 10:05
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;
+3 ;PATCH #5 - added the cancelled guest meal status and a screen for cancelled meals.
+4 ;
GETGM(FHGDT,FHGCOM,FHGLOC,FHGDFN) ;get guest meals data
+1 ;ENTRY POINTS:
+2 ; GETGM - get outpatient guest meals data from starting dt.
+3 ;input variable:
+4 ; FHGDT = starting date
+5 ; FHGCOM = IEN of communication office, 'ALL' for all.
+6 ; = if NULL, considered 'ALL'
+7 ; FHGLOC = IEN of location, 'ALL' for all.
+8 ; = if NULL, considered 'ALL'
+9 ; FHGDFN = IEN of file #115, 'ALL' for all.
+10 ; = if NULL, considered 'ALL'
+11 ;
+12 ;output variable:
+13 ; ^TMP($J,"OP","G",COMM OFF,PATIENT NAME,DTE)
+14 ;
+15 ;error:
+16 ; ^TMP($J,"OP","ER")
+17 KILL ^TMP($JOB,"OP","G")
+18 DO NEWVAR
+19 if FHGDFN=""
SET FHGDFN="ALL"
+20 if FHGCOM=""
SET FHGCOM="ALL"
+21 if FHGLOC=""
SET FHGLOC="ALL"
+22 SET FHGDT=FHGDT-.000001
+23 IF '$ORDER(^FHPT("GM",FHGDT))
SET ^TMP($JOB,"OP","ER")="NO GUEST MEALS FOR THIS DATE RANGE"
QUIT
+24 ;
+25 FOR FHGMDT=FHGDT:0
SET FHGMDT=$ORDER(^FHPT("GM",FHGMDT))
if FHGMDT'>0
QUIT
Begin DoDot:1
+26 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("GM",FHGMDT,FHDFN))
if FHDFN'>0
QUIT
Begin DoDot:2
+27 IF $GET(FHGDFN)
IF (FHGDFN'=FHDFN)
QUIT
+28 SET (FHGCOMN,FHPTNM,FHLOCN)=""
+29 SET FHNODE=$GET(^FHPT(FHDFN,"GM",FHGMDT,0))
+30 SET FHCL=$PIECE(FHNODE,U,2)
+31 SET FHML=$PIECE(FHNODE,U,3)
+32 SET FHCH=$PIECE(FHNODE,U,4)
+33 SET FHLPT=$PIECE(FHNODE,U,5)
+34 SET FHDIET=$PIECE(FHNODE,U,6)
+35 SET FHSTAT=$PIECE(FHNODE,U,9)
+36 ;quit if location is not the same
IF $GET(FHGLOC)
IF FHGLOC'=FHLPT
QUIT
+37 if $GET(FHLPT)
SET FHLCOM=$PIECE($GET(^FH(119.6,FHLPT,0)),U,8)
+38 ;quit if d same communication office
IF $GET(FHGCOM)
IF FHGCOM'=FHLCOM
QUIT
+39 if $GET(FHLCOM)
SET FHGCOMN=$PIECE($GET(^FH(119.73,FHLCOM,0)),U,1)
+40 if FHGCOMN=""
SET FHGCOMN="***"
+41 IF $GET(FHLPT)
Begin DoDot:3
+42 SET FHLOCN=$PIECE($GET(^FH(119.6,FHLPT,0)),U,1)
End DoDot:3
+43 if FHLOCN=""
SET FHLOCN="***"
+44 ;
+45 SET FHCL=$SELECT(FHCL="E":"EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOLUNTEER")
+46 SET FHD=$$FMTE^XLFDT(FHGMDT,"P")
+47 SET FHD=$EXTRACT(FHD,1,12)
+48 DO PATNAME^FHOMUTL
SET FHPTNM=$EXTRACT(FHPTNM,1,24)
+49 if FHPTNM=""
SET FHPTNM="***"
+50 SET ^TMP($JOB,"OP","G",FHGCOMN,FHLOCN,FHPTNM,FHGMDT)=FHDFN_"^"_FHD_"^"_FHML_"^"_FHCL_"^"_FHCH_"^"_FHDIET_"^"_FHSTAT
End DoDot:2
End DoDot:1
+51 QUIT
+52 ;
NEWVAR ;new all variables.
+1 NEW FHPTNM,FHD,FHDIET,FHMEAL,FHELTT,FHELBG,FHDAT,FHSTAT,FHLPT
+2 NEW FHAGE,FHCH,FHCL,FHDOB,FHGMDT,FHML,FHNODE,FHPCZN,FHSEX,FHSSN,FILE
+3 NEW FHDAT,FHDPT,FHEL,FHLPT,FHS,FHSMDT,FHSTAT,FHNN,FH
+4 QUIT
+5 ;
GETOUT ;get outpatient data for TODAY.
+1 ;output variables:
+2 ; ^TMP($J,"FH",##LOCATION,PATIENT NAME,DATE)=OP or SM or GM^IEN OF 115^MEAL^
+3 ;
+4 KILL ^TMP($JOB)
+5 NEW FHMEAL,FHDT,DT3,FHI,I,J,FHRMD,FHRMLNM,FHSMD,FHSMSTA,DFN,FHDFN
+6 NEW DTTST,FHSMLNM,FHGMLNM
+7 ;recurring meals
+8 SET FHDT=DT-.00001
SET DT3=DT+.999999
+9 FOR FHI=FHDT:0
SET FHI=$ORDER(^FHPT("RM",FHI))
if (FHI>DT3)!(FHI="")
QUIT
FOR I=0:0
SET I=$ORDER(^FHPT("RM",FHI,I))
if I'>0
QUIT
Begin DoDot:1
+10 FOR J=0:0
SET J=$ORDER(^FHPT("RM",FHI,I,J))
if J'>0
QUIT
Begin DoDot:2
+11 SET (FHRMD,FHMEAL)=""
+12 SET FHRMLNM="***"
+13 IF $DATA(^FHPT(I,"OP",J,0))
SET FHRMD=$GET(^FHPT(I,"OP",J,0))
+14 if $PIECE(FHRMD,U,15)="C"
QUIT
+15 IF $DATA(FHRMD)
SET FHMEAL=$PIECE(FHRMD,U,2)
+16 SET FHDFN=I
DO PATNAME^FHOMUTL
if DFN=""
QUIT
+17 if FHMEAL=""
SET FHMEAL=$PIECE(FHRMD,U,7)
+18 if FHMEAL=""
SET FHMEAL=$PIECE(FHRMD,U,8)
+19 if FHMEAL=""
SET FHMEAL=$PIECE(FHRMD,U,9)
+20 if FHMEAL=""
SET FHMEAL=$PIECE(FHRMD,U,10)
+21 if FHMEAL=""
SET FHMEAL=$PIECE(FHRMD,U,11)
+22 SET FHRMLOC=$PIECE(FHRMD,U,3)
if FHRMLOC=""
QUIT
+23 SET FHML=$PIECE(FHRMD,U,4)
+24 IF $GET(FHRMLOC)
IF $DATA(^FH(119.6,FHRMLOC,0))
Begin DoDot:3
+25 SET FHRMLNM=$PIECE(^FH(119.6,FHRMLOC,0),U,1)
+26 SET FHRMPR=$PIECE(^FH(119.6,FHRMLOC,0),U,4)
+27 SET FHRMSTA=$PIECE(^FH(119.6,FHRMLOC,0),U,8)
+28 if FHRMPR<10
SET FHRMPR=0_FHRMPR
+29 if FHRMPR=""
SET FHRMPR=99
End DoDot:3
+30 SET ^TMP($JOB,"FH",FHRMPR_FHRMLNM,FHPTNM,FHI,J)="OP"_"^"_I_"^"_FHMEAL_"^"_FHRMSTA_"^"_FHML_"^"_FHRMLOC_"^"_J
End DoDot:2
End DoDot:1
SM ;special meals
+1 SET FHDT=DT-.00001
SET DTTST=$PIECE(DT,".",1)
SET DT3=DTTST+1
+2 FOR FHI=FHDT:0
SET FHI=$ORDER(^FHPT("SM",FHI))
if (FHI>DT3)!(FHI="")
QUIT
FOR I=0:0
SET I=$ORDER(^FHPT("SM",FHI,I))
if I'>0
QUIT
Begin DoDot:1
+3 FOR J=0:0
SET J=$ORDER(^FHPT("SM",FHI,I,J))
if J'>0
QUIT
Begin DoDot:2
+4 SET (FHSMD,FHMEAL)=""
+5 SET FHSMSTA=""
+6 IF $DATA(^FHPT(I,"SM",J,0))
SET FHSMD=$GET(^FHPT(I,"SM",J,0))
+7 if $PIECE(FHSMD,U,2)'="A"
QUIT
+8 IF $DATA(FHSMD)
SET FHMEAL=$PIECE(FHSMD,U,4)
+9 SET FHDFN=I
DO PATNAME^FHOMUTL
if DFN=""
QUIT
+10 SET FHSMLOC=$PIECE(FHSMD,U,3)
if FHSMLOC=""
QUIT
+11 SET FHSMSTA=$PIECE(FHSMD,U,2)
+12 SET FHML=$PIECE(FHSMD,U,9)
+13 IF $GET(FHSMLOC)
IF $DATA(^FH(119.6,FHSMLOC,0))
Begin DoDot:3
+14 SET FHSMLNM=$PIECE(^FH(119.6,FHSMLOC,0),U,1)
+15 SET FHSMPR=$PIECE(^FH(119.6,FHSMLOC,0),U,4)
+16 SET FHSMSTA=$PIECE(^FH(119.6,FHSMLOC,0),U,8)
+17 if FHSMPR<10
SET FHSMPR=0_FHSMPR
+18 if FHSMPR=""
SET FHSMPR=99
End DoDot:3
+19 SET ^TMP($JOB,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="SM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
End DoDot:2
End DoDot:1
+20 ;guest meals
+21 SET FHDT=DT-.00001
SET DTTST=$PIECE(DT,".",1)
SET DT3=DTTST+1
+22 FOR FHI=FHDT:0
SET FHI=$ORDER(^FHPT("GM",FHI))
if (FHI>DT3)!(FHI="")
QUIT
FOR I=0:0
SET I=$ORDER(^FHPT("GM",FHI,I))
if I'>0
QUIT
Begin DoDot:1
+23 FOR J=0:0
SET J=$ORDER(^FHPT("GM",FHI,I,J))
if J'>0
QUIT
Begin DoDot:2
+24 SET (FHSMD,FHMEAL)=""
+25 SET FHSMSTA=""
+26 SET FHSMLNM="***"
+27 IF $DATA(^FHPT(I,"GM",J,0))
SET FHSMD=$GET(^FHPT(I,"GM",J,0))
+28 if $PIECE(FHSMD,U,9)="C"
QUIT
+29 IF $DATA(FHSMD)
SET FHMEAL=$PIECE(FHSMD,U,6)
+30 SET FHDFN=I
DO PATNAME^FHOMUTL
if DFN=""
QUIT
+31 SET FHSMLOC=$PIECE(FHSMD,U,5)
if FHSMLOC=""
QUIT
+32 SET FHML=$PIECE(FHSMD,U,3)
+33 IF $GET(FHSMLOC)
IF $DATA(^FH(119.6,FHSMLOC,0))
Begin DoDot:3
+34 SET FHSMLNM=$PIECE(^FH(119.6,FHSMLOC,0),U,1)
+35 SET FHSMSTA=$PIECE(^FH(119.6,FHSMLOC,0),U,8)
+36 SET FHSMPR=$PIECE(^FH(119.6,FHSMLOC,0),U,4)
+37 if FHSMPR<10
SET FHSMPR=0_FHSMPR
+38 if FHSMPR=""
SET FHSMPR=99
End DoDot:3
+39 SET ^TMP($JOB,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="GM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
End DoDot:2
End DoDot:1
+40 QUIT
