138 lines
6.4 KiB
Mathematica
138 lines
6.4 KiB
Mathematica
FHORX1 ; HISC/REL/RVD - Diet Activity Report ;9/10/98 15:31
|
|
;;5.5;DIETETICS;**1,8**;Jan 28, 2005;Build 28
|
|
;RVD patch #1 - get outpatient info from Nutrition Events file.
|
|
;
|
|
D NOW^%DTC S NOW=%,TIM=""
|
|
R0 D DIV^FHOMUTL G:'$D(FHSITE) KIL
|
|
S FHP=FHSITE
|
|
R1 R !!,"Do you want labels? N// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="N" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Enter YES or NO" G R1
|
|
S LAB=X?1"Y".E
|
|
S:$G(FHP) TIM=$P($G(^FH(119.73,FHP,0)),"^",$S(LAB:3,1:2))
|
|
I 'TIM S TIM=DT
|
|
S FHLBFLG=1 I LAB D I FHLBFLG=0 Q
|
|
.W ! K DIR,LABSTART S DIR(0)="NA^1:10",DIR("A")="If using laser label sheets, what row do you want to begin printing at? ",DIR("B")=1 D ^DIR
|
|
.I $D(DIRUT) S FHLBFLG=0 Q
|
|
.S LABSTART=Y Q
|
|
S DTP=TIM D DTP^FH
|
|
R3 W !!,"Changes since Date/Time: ",DTP," // " R X:DTIME G:'$T!(X["^") KIL I X'="" S %DT="EXTS" D ^%DT K %DT G:Y<1 R3 S TIM=Y
|
|
W ! K IOP,%ZIS S %ZIS("A")="Select "_$S(LAB:"LABEL",1:"LIST")_" Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
|
|
I $D(IO("Q")) S FHPGM="Q1^FHORX1",FHLST="TIM^LAB^FHP^LABSTART^FHSITE^FHSITENM" D EN2^FH G KIL
|
|
U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
|
|
Q1 ; Print the Diet Activity Report
|
|
S FHTIM=TIM ;save date/time for recurring meal data.
|
|
K ^TMP($J) D NOW^%DTC S NOW=%,DTP=TIM,TIM=TIM-.000001 D DTP^FH S H1=DTP_" - " S DTP=NOW D DTP^FH S H1=H1_DTP D ^FHDEV
|
|
F W1=0:0 S W1=$O(^FH(119.6,W1)) Q:W1<1 D WRD
|
|
I LAB S LAB=$P($G(^FH(119.9,1,"D",IOS,0)),"^",2) S:'LAB LAB=1
|
|
F LLL=TIM:0 S LLL=$O(^FH(119.8,"AD",LLL)) Q:LLL<1 F DA=0:0 S DA=$O(^FH(119.8,"AD",LLL,DA)) Q:DA<1 D Q3
|
|
;
|
|
OUTP ;get outpatient data
|
|
F LLL=TIM:0 S LLL=$O(^FH(119.8,"AD",LLL)) Q:LLL<1 F DA=0:0 S DA=$O(^FH(119.8,"AD",LLL,DA)) Q:DA<1 D
|
|
.S FHPROR=99,(FHTC,FHCOMO)=""
|
|
.S Z=$G(^FH(119.8,DA,0)) Q:Z=""
|
|
.S FHDTIM=$P(Z,"^",2),FHDFN=$P(Z,"^",3),FHOUTP=$P(Z,"^",5)
|
|
.Q:FHOUTP'="Z"
|
|
.S FHACTI=$P(Z,"^",6)
|
|
.S FHDESC=$P(Z,"^",8),FHLOCN=$P(FHDESC,",",2)
|
|
.S FHLOCN=$E(FHLOCN,2,$L(FHLOCN))
|
|
.S:FHLOCN'="" FHLIEN=$O(^FH(119.6,"B",FHLOCN,0))
|
|
.I $G(FHLIEN) D
|
|
..S FHPROR=$P($G(^FH(119.6,FHLIEN,0)),U,4)
|
|
..S FHSERV1=$P($G(^FH(119.6,FHLIEN,0)),U,5)
|
|
..I $G(FHSERV1),$D(^FH(119.72,FHSERV1,0)) S FHTC=FHTC_$P(^(0),U,2)
|
|
..S FHSERV2=$P($G(^FH(119.6,FHLIEN,0)),U,6)
|
|
..I $G(FHSERV2),$D(^FH(119.72,FHSERV2,0)) S FHTC=FHTC_$P(^(0),U,2)
|
|
..S FHSERV3=$P($G(^FH(119.6,FHLIEN,0)),U,7)
|
|
..I $G(FHSERV3) S FHTC=FHTC_"D"
|
|
..S FHCOMO=$P($G(^FH(119.6,FHLIEN,0)),U,8)
|
|
.I $G(FHSITE),FHCOMO'=FHSITE Q
|
|
.S FHCLER=$P(Z,"^",9)
|
|
.S FHPTNM="***"
|
|
.S:FHLOCN="" FHLOCN="***"
|
|
.D PATNAME^FHOMUTL
|
|
.S FHLPAT=FHPROR_"~"_FHLOCN_"~~"_DFN_"~"_FHPTNM
|
|
.S DTP=FHDTIM D DTP^FH
|
|
.S ^TMP($J,"O",FHLPAT,DA)=FHACTI_"^"_DTP_"^"_FHBID_"^"_FHDESC_"^"_FHTC
|
|
;
|
|
;D PROSG ;print outpatient data
|
|
;go to routines for printing report
|
|
G ^FHORX1A:'LAB,^FHORX1B
|
|
WRD S P0=$G(^FH(119.6,W1,0)),WRDN=$P(P0,"^",1),D2=$P(P0,"^",8),P0=$P(P0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
|
|
I $G(FHP),D2=FHP S ^TMP($J,"W",W1)=P0_"~"_WRDN
|
|
I '$G(FHP) S ^TMP($J,"W",W1)=P0_"~"_WRDN
|
|
Q
|
|
Q3 S Z=$G(^FH(119.8,DA,0)) Q:Z="" S TM1=($P(Z,"^",2)\1),FHDFN=$P(Z,"^",3),ADM=$P(Z,"^",4) Q:'$G(ADM) Q:'$D(^FHPT(FHDFN,"A",ADM,0))
|
|
D PATNAME^FHOMUTL I DFN="" Q
|
|
S WARD=$G(^DPT(DFN,.1)) G:WARD="" Q5 ; Not an inpatient
|
|
I $G(^DPT("CN",WARD,DFN))'=ADM Q ; Not current admission
|
|
S X0=^FHPT(FHDFN,"A",ADM,0),W1=+$P(X0,"^",8) I '$D(^TMP($J,"W",W1)) Q ; Not in this Comm Office
|
|
S R1=$G(^DPT(DFN,.101))
|
|
S RI=$G(^DPT(DFN,.108)) S RE=$S(RI:$O(^FH(119.6,"AR",+RI,W1,0)),1:"")
|
|
S R0=$S(RE:$P($G(^FH(119.6,W1,"R",+RE,0)),"^",2),1:"")
|
|
S R0=$S(R0<1:99,R0<10:"0"_R0,1:R0)
|
|
S ^TMP($J,"I",^TMP($J,"W",W1)_"~"_R0_"~"_R1_"~"_FHDFN,DA)=$P(Z,"^",4,9) Q
|
|
Q5 ; process discharges
|
|
S W1=+$P(Z,"^",8) Q:'W1 Q:'$D(^TMP($J,"W",W1))
|
|
S ^TMP($J,"I",^TMP($J,"W",W1)_"~~***~"_FHDFN,DA)=$P(Z,"^",4,9)
|
|
Q
|
|
;
|
|
PROSG ;process recurring, special and guest meals.
|
|
S FHPLNM=""
|
|
S:$G(FHP) FHPLNM=$P($G(^FH(119.73,FHP,0)),U,1)
|
|
REC ;for recurring meals
|
|
;S FHTMPS=$NA(^TMP($J,"OP","R",FHPLNM))
|
|
S FHTMPS="^TMP($J,""OP"",""R"")"
|
|
S FHN="" F S FHN=$O(@FHTMPS@(FHN)) Q:FHN="" S FHI="" F S FHI=$O(@FHTMPS@(FHN,FHI)) Q:FHI="" S FHJ="" F S FHJ=$O(@FHTMPS@(FHN,FHI,FHJ)) Q:FHJ="" D
|
|
.I (FHPLNM'=""),(FHN'=FHPLNM) Q
|
|
.S FHPROR="01",FHLOC=""
|
|
.S:$D(^FH(119.6,"B",FHI)) FHLOC=$O(^FH(119.6,"B",FHI,0))
|
|
.S:$G(FHLOC) FHPROR=$P($G(^FH(119.6,FHLOC,0)),U,4)
|
|
.F FHK=0:0 S FHK=$O(@FHTMPS@(FHN,FHI,FHJ,FHK)) Q:(FHK'>0)!(FHK>NOW) D
|
|
..S (FHRDAT,FHIJKDAT)=@FHTMPS@(FHN,FHI,FHJ,FHK)
|
|
..S $P(FHRDAT,U,3)=$P(FHIJKDAT,U,18)
|
|
..S $P(FHRDAT,U,4)=$P(FHIJKDAT,U,3)
|
|
..S $P(FHRDAT,U,9)=$P(FHIJKDAT,U,4)
|
|
..S $P(FHRDAT,U,5)=$P(FHIJKDAT,U,8)
|
|
..S $P(FHRDAT,U,8)=$P(FHIJKDAT,U,7)
|
|
..S $P(FHRDAT,U,13)=$P(FHIJKDAT,U,17)
|
|
..S FHLPAT=FHPROR_"~"_FHI_"~~~"_$P(FHIJKDAT,U,1)
|
|
..S ^TMP($J,"O",FHLPAT,FHK)="RECURRING"_"^"_FHJ_"^"_FHRDAT
|
|
SPEC ;for special meals
|
|
;S FHPLNM=$P($G(^FH(119.73,FHP,0)),U,1) Q:FHPLNM="" ;quit if no comm
|
|
;S FHTMPS=$NA(^TMP($J,"OP","S"))
|
|
S FHTMPS="^TMP($J,""OP"",""S"")"
|
|
S FHN="" F S FHN=$O(@FHTMPS@(FHN)) Q:FHN="" S FHI="" F S FHI=$O(@FHTMPS@(FHN,FHI)) Q:FHI="" S FHJ="" F S FHJ=$O(@FHTMPS@(FHN,FHI,FHJ)) Q:FHJ="" D
|
|
.I (FHPLNM'=""),(FHN'=FHPLNM) Q
|
|
.S FHPROR="01",FHLOC=""
|
|
.S:$D(^FH(119.6,"B",FHI)) FHLOC=$O(^FH(119.6,"B",FHI,0))
|
|
.S:$G(FHLOC) FHPROR=$P($G(^FH(119.6,FHLOC,0)),U,4)
|
|
.F FHK=0:0 S FHK=$O(@FHTMPS@(FHN,FHI,FHJ,FHK)) Q:(FHK'>0)!(FHK>NOW) D
|
|
..S FHIJKDAT=@FHTMPS@(FHN,FHI,FHJ,FHK)
|
|
..S FHLPAT=FHPROR_"~"_FHI_"~~~"_$P(FHIJKDAT,U,1)
|
|
..S ^TMP($J,"O",FHLPAT,FHK)="SPECIAL"_"^"_FHJ_"^"_FHIJKDAT
|
|
;for guest meals
|
|
GUEST ;S FHTMPS=$NA(^TMP($J,"OP","G",FHPLNM))
|
|
S FHTMPS="^TMP($J,""OP"",""G"")"
|
|
S FHN="" F S FHN=$O(@FHTMPS@(FHN)) Q:FHN="" S FHI="" F S FHI=$O(@FHTMPS@(FHN,FHI)) Q:FHI="" S FHJ="" F S FHJ=$O(@FHTMPS@(FHN,FHI,FHJ)) Q:FHJ="" D
|
|
.I (FHPLNM'=""),(FHN'=FHPLNM) Q
|
|
.S FHPROR="01",FHLOC=""
|
|
.S:$D(^FH(119.6,"B",FHI)) FHLOC=$O(^FH(119.6,"B",FHI,0))
|
|
.S:$G(FHLOC) FHPROR=$P($G(^FH(119.6,FHLOC,0)),U,4)
|
|
.F FHK=0:0 S FHK=$O(@FHTMPS@(FHN,FHI,FHJ,FHK)) Q:(FHK'>0)!(FHK>NOW) D
|
|
..S FHIJKDAT=@FHTMPS@(FHN,FHI,FHJ,FHK)
|
|
..S FHGDIET=$P($G(^FH(119.9,1,0)),U,2)
|
|
..S $P(FHIJKDAT,U,9)=$P(FHIJKDAT,U,3)
|
|
..S $P(FHIJKDAT,U,14)=$P(FHIJKDAT,U,4)
|
|
..S $P(FHIJKDAT,U,15)=$P(FHIJKDAT,U,5)
|
|
..S FHGDIETN=$P(FHIJKDAT,U,6)
|
|
..I $G(FHGDIETN),$D(^FH(111,FHGDIETN,0)) D
|
|
...S FHGDTNM=$P(^FH(111,FHGDIETN,0),U,1)
|
|
..E S:$G(FHGDIET) FHGDTNM=$P($G(^FH(111,FHGDIET,0)),U,1)
|
|
..S $P(FHIJKDAT,U,4)=FHGDTNM
|
|
..I $G(FHGDIET),$D(^FH(111,FHGDIET,0)) D
|
|
...S $P(FHIJKDAT,U,4)=$P(^FH(111,FHGDIET,0),U,1)
|
|
..S FHLPAT=FHPROR_"~"_FHI_"~~~"_$P(FHIJKDAT,U,1)
|
|
..S ^TMP($J,"O",FHLPAT,FHK)="GUEST"_"^"_FHJ_"^"_FHIJKDAT
|
|
Q
|
|
;
|
|
KIL K ^TMP($J) G KILL^XUSCLEAN
|