FHDCR1A ; HISC/REL/NCA/RVD - Build Diet Cards ;1/21/99  14:04
 ;;5.5;DIETETICS;**1,5**;Jan 28, 2005;Build 53
 ;patch #5 - added the screen for cancelled Guest meal.
B1 ; Store wards
 K ^TMP($J),NN,N,P S MFLG=0 D Q1^FHDCR1B D NOW^%DTC S (DTP,TIM)=% D DTP^FH S HD=DTP S:MEAL="A" MFLG=1
 S DTP=D1 D DTP^FH S (MDT,MEALDT)=DTP,MEALDT=$J("",62-$L(MEALDT)\2)_MEALDT
 S FHBOT=$P($G(^FH(119.9,1,4)),"^",1)
 S FHD1=D1-.00001,FHD2=D1+.99999
 S FHDFNSAV="",FHW1SAV=W1,FHFHPSAV=FHP,FHMEALSA=MEAL
 S:$G(FHDFN) FHDFNSAV=FHDFN
 I $G(DFN),'$D(^DPT(DFN,.1)) G OUTALL
 I '$G(DFN),$G(FHDFN) G OUTALL
 ;next process inpatient data
DFN I $G(DFN),$G(FHDFN) D  Q
 .S ADM=+$G(^DPT(DFN,.105)),W1=+$P($G(^FHPT(FHDFN,"A",+ADM,0)),"^",8)
 .S K1=$G(^FH(119.6,+W1,0)),WRDN=$P(K1,"^",1),SP=$P(K1,"^",5),SP1=$P(K1,"^",6),FHPAR=$P(K1,"^",24),RM=$G(^DPT(DFN,.101))
 .I 'SP Q:FHPAR'="Y"  S SP=SP1 Q:'SP
 .K PP,S,MM S NBR=0
 .I 'TPP D BLD^FHDCR11 D:NBR UPD,PRT^FHDCR1C Q
 .I 'MFLG D BLD^FHDCR1D D:NBR UPD,PRT^FHMTK1C Q
 .F MEAL="B","N","E" D BLD^FHDCR1D
 .D UPD
 .D:NBR PRT^FHMTK1C
 ;if ward, do specific ward/location;otherwise, do all entry for all
 ;wards/locations and all communication offices.
WARD I W1 S ^TMP($J,"W","01"_$P($G(^FH(119.6,+W1,0)),"^",1))=W1_"^"_$P($G(^FH(119.6,+W1,0)),"^",5,6)_"^"_$P($G(^FH(119.6,+W1,0)),"^",24)
 E  F W1=0:0 S W1=$O(^FH(119.6,W1)) Q:W1<1  D
 .S P0=$G(^FH(119.6,W1,0)),WRDN=$P(P0,"^",1),SP=$P(P0,"^",5,6),D2=$P(P0,"^",8),FHPAR=$P(P0,"^",24),P0=$P(P0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
 .I FHP,D2'=FHP Q
 .S ^TMP($J,"W",P0_WRDN)=W1_"^"_SP_"^"_FHPAR Q
 S NX="" F  S NX=$O(^TMP($J,"W",NX)) Q:NX=""  S X1=$G(^(NX)),W1=+X1,FHS=$P(X1,"^",2),SP1=$P(X1,"^",3),FHPAR=$P(X1,"^",4),WRDN=$E(NX,3,99) S:'FHS&(FHPAR="Y") FHS=SP1 I FHS K ^TMP($J,"D") D
 .F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",W1,FHDFN)) Q:FHDFN<1  D
 ..D PATNAME^FHOMUTL Q:'$G(DFN)
 ..S ADM=$G(^FHPT("AW",W1,FHDFN))
 ..I SORT="A" S RM=$P($G(^DPT(DFN,0)),"^",1),DL=0,RMB=$G(^DPT(DFN,.101)) S:RMB="" RMB="***"
 ..E  S RI=$G(^DPT(DFN,.108)),RM=$G(^DPT(DFN,.101)) S:RM="" RM="***" S:RI RE=$O(^FH(119.6,"AR",+RI,W1,0)) S:'RI RE="" S DL=$S(RE:$P($G(^FH(119.6,W1,"R",+RE,0)),"^",2),1:""),RMB=""
 ..S DL=$S(DL<1:99,DL<10:"0"_DL,1:DL)
 ..S ^TMP($J,"D",DL_"~"_RM_"~"_$S(SORT="R":DFN,1:RMB))=DFN_"^"_ADM_"^"_FHDFN Q
 .;
 .K ^TMP($J,"MP"),^TMP($J,0),MM,PP,S S X9="",NBR=0 F  S X9=$O(^TMP($J,"D",X9)) Q:X9=""  S FHX6=$G(^(X9)) S DFN=$P(FHX6,"^",1),ADM=$P(FHX6,"^",2) D
 ..S FHDFN=$P(FHX6,"^",3)
 ..S RM=$S(SORT="R":$P(X9,"~",2),1:$P(X9,"~",3)) S SP=FHS
 ..I TPP D  Q
 ...I 'MFLG D BLD^FHDCR1D,UPD Q
 ...F MEAL="B","N","E" D BLD^FHDCR1D
 ...D UPD
 ...Q
 ..I 'TPP D BLD^FHDCR11 D UPD Q
 .I NBR,TPP D PRT^FHMTK1C Q
 .D:NBR PRT^FHDCR1C
 ;
OUTALL K ^TMP($J,"D")   ;reset/clean-up tmp global outpatient process.
 ;process outpatient data
 ;next recurring
 F FHK1=FHD1:0 S FHK1=$O(^FHPT("RM",FHK1)) Q:(FHK1'>0)!(FHK1>FHD2)  D
 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHK1,FHDFN)) Q:FHDFN'>0  D
 ..F FHKD=0:0 S FHKD=$O(^FHPT("RM",FHK1,FHDFN,FHKD)) Q:FHKD'>0  D
 ...S FHKDAT=^FHPT(FHDFN,"OP",FHKD,0)
 ...S (W1,FHW1)=$P(FHKDAT,U,3)
 ...S FHRMB=$P(FHKDAT,U,18)
 ...S FHDIET=$P(FHKDAT,U,2),FHMEAL=$P(FHKDAT,U,4),FHSTAT=$P(FHKDAT,U,15)
 ...S:FHDIET="" FHDIET=$E(FHKDAT,7,11)
 ...I (FHMEALSA'="A"),(FHMEAL'=FHMEALSA) Q
 ...I FHSTAT="C" Q
 ...I $G(FHW1SAV),(FHW1'=FHW1SAV) Q
 ...I $G(FHDFNSAV),(FHDFN'=FHDFNSAV) Q
 ...S FHLOC="",FHRGS="OP"
 ...Q:'$G(FHW1)
 ...S:$D(^FH(119.6,FHW1,0)) FHLOC=$P(^FH(119.6,FHW1,0),U,8)
 ...I $G(FHFHPSAV),$G(FHLOC),(FHFHPSAV'=FHLOC) Q
 ...S FHDFN1=$P(^FHPT(FHDFN,0),U,1)
 ...I $G(FHW1SAV)!($G(FHFHPSAV)) D OUTW Q
 ...I $G(FHDFNSAV) D OUTP Q
 ...D OUTW
 ;next guest
 F FHKD=FHD1:0 S FHKD=$O(^FHPT("GM",FHKD)) Q:(FHKD'>0)!(FHKD>FHD2)  D
 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHKD,FHDFN)) Q:FHDFN'>0  D
 ..S FHKDAT=^FHPT(FHDFN,"GM",FHKD,0)
 ..S (W1,FHW1)=$P(FHKDAT,U,5)
 ..S FHSTAT=$P(FHKDAT,U,9)
 ..Q:FHSTAT="C"
 ..S FHRMB=$P(FHKDAT,U,11)
 ..S FHDIET=$P(FHKDAT,U,6),FHMEAL=$P(FHKDAT,U,3)
 ..I (FHMEALSA'="A"),(FHMEAL'=FHMEALSA) Q
 ..I $G(FHW1SAV),(FHW1'=FHW1SAV) Q
 ..I $G(FHDFNSAV),(FHDFN'=FHDFNSAV) Q
 ..S FHLOC="",FHRGS="GM"
 ..Q:'$G(FHW1)
 ..S:$D(^FH(119.6,FHW1,0)) FHLOC=$P(^FH(119.6,FHW1,0),U,8)
 ..I $G(FHFHPSAV),$G(FHLOC),(FHFHPSAV'=FHLOC) Q
 ..S FHDFN1=$P(^FHPT(FHDFN,0),U,1)
 ..I $G(FHW1SAV)!($G(FHFHPSAV)) D OUTW Q
 ..I $G(FHDFNSAV) D OUTP Q
 ..D OUTW
 ;next SPECIAL
 F FHKD=FHD1:0 S FHKD=$O(^FHPT("SM",FHKD)) Q:(FHKD'>0)!(FHKD>FHD2)  D
 .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHKD,FHDFN)) Q:FHDFN'>0  D
 ..S FHKDAT=^FHPT(FHDFN,"SM",FHKD,0)
 ..S (W1,FHW1)=$P(FHKDAT,U,3)
 ..S FHRMB=$P(FHKDAT,U,13)
 ..S FHDFN1=$P(^FHPT(FHDFN,0),U,1)
 ..S FHDIET=$P(FHKDAT,U,4),FHMEAL=$P(FHKDAT,U,9),FHSTAT=$P(FHKDAT,U,2)
 ..I (FHMEALSA'="A"),(FHMEAL'=FHMEALSA) Q
 ..I (FHSTAT="C")!(FHSTAT="D") Q
 ..I $G(FHW1SAV),(FHW1'=FHW1SAV) Q
 ..I $G(FHDFNSAV),(FHDFN'=FHDFNSAV) Q
 ..S FHLOC="",FHRGS="SM"
 ..Q:'$G(FHW1)
 ..S:$D(^FH(119.6,FHW1,0)) FHLOC=$P(^FH(119.6,FHW1,0),U,8)
 ..I $G(FHFHPSAV),$G(FHLOC),(FHFHPSAV'=FHLOC) Q
 ..S FHDFN1=$P(^FHPT(FHDFN,0),U,1)
 ..I $G(FHW1SAV)!($G(FHFHPSAV)) D OUTW Q
 ..I $G(FHDFNSAV) D OUTP Q
 ..D OUTW
 ;
 K ^TMP($J,"MP"),^TMP($J,0),MM,PP,S S X9="",NBR=0 F  S X9=$O(^TMP($J,"D",X9)) Q:X9=""  S FHX6=$G(^(X9)) S FHDFN=$P(FHX6,"^",1),ADM=$P(FHX6,"^",2) D
 .S RM=$S(SORT="R":$P(X9,"~",2),1:$P(X9,"~",3)) S SP=FHS
 .S FHDFN=$P(FHX6,"^",1),FHRGS=$P(FHX6,"^",2)
 .D PATNAME^FHOMUTL
 .S FHKD=$P(FHX6,"^",3),W1=$P(FHX6,"^",4)
 .Q:$G(FHRGS)!('$G(FHKD))
 .S FHSTAT="",FHADM=FHKD
 .S FHKDAT=$G(^FHPT(FHDFN,""_FHRGS_"",FHKD,0))
 .I FHRGS="GM" S W1=$P(FHKDAT,U,5),FHDIET=$P(FHKDAT,U,6),FHMEAL=$P(FHKDAT,U,3)
 .I FHRGS="OP" S W1=$P(FHKDAT,U,3),FHDIET=$P(FHKDAT,U,2),FHMEAL=$P(FHKDAT,U,4),FHSTAT=$P(FHKDAT,U,15)
 .I FHRGS="SM" S W1=$P(FHKDAT,U,3),FHDIET=$P(FHKDAT,U,4),FHMEAL=$P(FHKDAT,U,9),FHSTAT=$P(FHKDAT,U,2)
 .;don't process IF STATUS IS cancelled or denied
 .I (FHSTAT="C")!(FHSTAT="D") Q
 .S K1=$G(^FH(119.6,+W1,0)),WRDN=$P(K1,"^",1),SP=$P(K1,"^",5),SP1=$P(K1,"^",6),FHPAR=$P(K1,"^",24)
 .I 'SP Q:FHPAR'="Y"  S SP=SP1 Q:'SP
 .I TPP D  Q
 ..I 'MFLG,'ADM D OUT^FHDCR1D,@FHRGS Q
 ..F MEAL="B","N","E" D:'ADM OUT^FHDCR1D
 ..D:'ADM @FHRGS
 .I 'TPP,'ADM D OUT^FHDCR11 D @FHRGS Q
 I NBR,TPP D PRT^FHMTK1C Q
 D:NBR PRT^FHDCR1C
 Q
 ;
UPD ; Update Date/Time Diet Card was Printed
 S $P(^FHPT(FHDFN,"A",ADM,0),"^",16)=TIM Q
OUTP ;process outpatient using patient
 S RM="***"
 S K1=$G(^FH(119.6,+W1,0)),WRDN=$P(K1,"^",1),SP=$P(K1,"^",5),SP1=$P(K1,"^",6),FHPAR=$P(K1,"^",24)
 I 'SP Q:FHPAR'="Y"  S SP=SP1 Q:'SP
 K PP,S,MM S NBR=0,FHADM=FHKD I $G(FHRMB),$D(^DG(405.4,FHRMB,0)) S RM=$P(^DG(405.4,FHRMB,0),U,1)
 I 'TPP D OUT^FHDCR11 D:NBR @FHRGS,PRT^FHDCR1C K ^TMP($J,"MP"),^TMP($J,0),PP,S,TT,SRT Q
 I 'MFLG D OUT^FHDCR1D D:NBR @FHRGS,PRT^FHMTK1C Q
 F MEAL="B","N","E" D OUT^FHDCR1D
 D @FHRGS
 D:NBR PRT^FHMTK1C
 Q
OP S $P(^FHPT(FHDFN,"OP",FHKD,0),"^",14)=TIM Q
GM S $P(^FHPT(FHDFN,"GM",FHKD,0),"^",8)=TIM Q
SM S $P(^FHPT(FHDFN,"SM",FHKD,0),"^",11)=TIM Q
 ;
OUTW ;process outpatient using all and ward.
 ;F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",W1,FHDFN)) Q:FHDFN<1  D
 D PATNAME^FHOMUTL
 S (RM,RMB)="***"
 I $G(FHRMB),$D(^DG(405.4,FHRMB,0)) S RMB=$P(^DG(405.4,FHRMB,0),U,1)
 I SORT="A" S RM=FHPTNM,DL=0
 E  S (RI,RE,DL)="***",RM=RMB
 S ^TMP($J,"D",DL_"~"_RM_"~"_$S(SORT="R":FHDFN,1:RMB)_FHMEAL)=FHDFN_"^"_FHRGS_"^"_FHKD_"^"_W1
 Q