- 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
- 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
