110 lines
5.2 KiB
Mathematica
110 lines
5.2 KiB
Mathematica
FHORT5A ; HISC/REL/NCA/RVD - Tubefeeding Reports (cont) ;3/1/04 13:15
|
|
;;5.5;DIETETICS;**1,3,5**;Jan 28, 2005;Build 53
|
|
;
|
|
Q1 ; Print Tubefeeding Report
|
|
S PG=0 D NOW^%DTC S (DTP,NOW)=% D DTP^FH K ^TMP($J)
|
|
INPAT ;get inpatient data
|
|
F FHDFN=0:0 S FHDFN=$O(^FHPT("ADTF",FHDFN)) Q:FHDFN<1 F ADM=0:0 S ADM=$O(^FHPT("ADTF",FHDFN,ADM)) Q:ADM<1 D PATNAME^FHOMUTL Q:DFN="" D Q2
|
|
;
|
|
OUTPAT ;get outpatient data, for today's date.
|
|
F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",DT,FHDFN)) Q:FHDFN'>0 F FHFIN=0:0 S FHFIN=$O(^FHPT("RM",DT,FHDFN,FHFIN)) Q:FHFIN'>0 D
|
|
.;quit if TF is cancelled
|
|
.I $D(^FHPT(FHDFN,"OP",FHFIN,3)),$P(^(3),U,5)="C" Q
|
|
.S (FHRMB,RM)=" "
|
|
.I $D(^FHPT(FHDFN,"OP",FHFIN,0)) S FHRMB=$P($G(^FHPT(FHDFN,"OP",FHFIN,0)),U,18)
|
|
.I $G(FHRMB),$D(^DG(405.4,FHRMB,0)) S RM=$P(^DG(405.4,FHRMB,0),U,1)
|
|
.F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF)) Q:FHTF'>0 D
|
|
..Q:'$D(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF,0))
|
|
..S YY=$G(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF,0))
|
|
..;
|
|
..S TF2=FHTF
|
|
..S Z=$G(^FHPT(FHDFN,"OP",FHFIN,0))
|
|
..S XY=$G(^FHPT(FHDFN,"OP",FHFIN,3))
|
|
..S (Z1,Z2)="",W1=$P(Z,"^",3)
|
|
..S P0=$G(^FH(119.6,+W1,0)),Z3=$P(P0,"^",8),WARD=$E($P(P0,"^",1),U,12)
|
|
..S CC=$P($G(^FH(119.73,+Z3,0)),"^",1)
|
|
..I FHXX="C" S D2=$P(P0,"^",8) I FHP,FHP'=D2 Q
|
|
..I FHXX="L" I FHP,FHP'=W1 Q
|
|
..S P0=$P(P0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
|
|
..S TNOD=$S(FHXX="C":"99~"_CC,1:P0_"~"_WARD),CNOD=$S('SUM:TNOD,1:"0")
|
|
..;
|
|
..I FHOPT=3 D
|
|
...S CTR=$G(^TMP($J,"C",CNOD,0))
|
|
...;I "^^^^"[FHOR S:Z2 $P(CTR,"^",1)=$P(CTR,"^",1)+1 S:Z2 $P(CTR,"^",3)=$P(CTR,"^",3)+1
|
|
...S $P(CTR,"^",1)=$P(CTR,"^",1)+1
|
|
...;I "^^^^"'[FHOR,Z1="T" S:'Z2 $P(CTR,"^",2)=$P(CTR,"^",2)+1 S:Z2 $P(CTR,"^",4)=$P(CTR,"^",4)+1
|
|
...S ^TMP($J,"C",CNOD,0)=CTR Q
|
|
..;
|
|
..S TP=$P(YY,"^",4) D PREP
|
|
..;set ^tmp global for specific report.
|
|
..D PATNAME^FHOMUTL
|
|
..S PNOD=P0_"~"_WARD_"~"_FHDFN
|
|
..I "135"[FHOPT S:'$D(^TMP($J,"C",CNOD,TUN,0)) ^(0)="" S $P(^(0),"^",1)=$P(^(0),"^",1)+TU,$P(^(0),"^",2)=$P(^(0),"^",2)+1
|
|
..I "124"[FHOPT D
|
|
...S:'$D(^TMP($J,"T",TNOD,PNOD,0)) ^(0)=$E(FHPTNM,1,22)_"^"_FHBID_"^"_WARD_"^"_RM_"^"_$P(XY,"^",1,3)
|
|
...S ^TMP($J,"T",TNOD,PNOD,TF2,0)=$P(Y0,"^",1)_"^"_$P(Y0,"^",2)_"^"_TP_"^"_TW_"^"_TU_"^"_P1_"^"_STR_"^"_QUA_"^"_TUN
|
|
;
|
|
PRT ;prints corresponding reports.
|
|
I FHOPT=1 D PREP^FHORT5B,PULL^FHORT5C,DEL^FHORT5C Q
|
|
I FHOPT=2 D PREP^FHORT5B Q
|
|
I FHOPT=3 D CST^FHORT5D Q
|
|
I FHOPT=4 D LAB^FHORT5D Q
|
|
I FHOPT=5 D PULL^FHORT5C
|
|
Q
|
|
Q2 S Z=$G(^FHPT(FHDFN,"A",ADM,0)),WARD=$P(Z,"^",8) S:WARD WARD=$P($G(^FH(119.6,WARD,0)),"^",1) I WARD="" G Q3
|
|
G:'$D(^DPT(DFN,.1)) Q3 S CADM=$G(^DPT("CN",^DPT(DFN,.1),DFN)) G:ADM'=CADM Q3
|
|
S TF=$P(Z,"^",4) G:TF<1 Q3
|
|
S Z1=$P(Z,"^",5),Z2=$P(Z,"^",7),W1=$P(Z,"^",8),P0=$G(^FH(119.6,+W1,0)),Z3=$P(P0,"^",8),CC=$P($G(^FH(119.73,+Z3,0)),"^",1)
|
|
I FHXX="C" S D2=$P(P0,"^",8) I FHP,FHP'=D2 Q
|
|
I FHXX="L" I FHP,FHP'=W1 Q
|
|
S P0=$P(P0,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
|
|
S TNOD=$S(FHXX="C":"99~"_CC,1:P0_"~"_WARD),CNOD=$S('SUM:TNOD,1:"0")
|
|
D CUR^FHORD7 I FHLD="P" Q
|
|
I FHOPT=3 D
|
|
.S CTR=$G(^TMP($J,"C",CNOD,0))
|
|
.I "^^^^"[FHOR S:'Z2 $P(CTR,"^",1)=$P(CTR,"^",1)+1 S:Z2 $P(CTR,"^",3)=$P(CTR,"^",3)+1
|
|
.I "^^^^"'[FHOR,Z1="T" S:'Z2 $P(CTR,"^",2)=$P(CTR,"^",2)+1 S:Z2 $P(CTR,"^",4)=$P(CTR,"^",4)+1
|
|
.S ^TMP($J,"C",CNOD,0)=CTR Q
|
|
I "124"[FHOPT D
|
|
.S RM=$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 PNOD=P0_"~"_R0_RM_"~"_DFN,X=^DPT(DFN,0) D PID^FHDPA
|
|
.S XY=^FHPT(FHDFN,"A",ADM,"TF",TF,0)
|
|
.S ^TMP($J,"T",TNOD,PNOD,0)=$E($P(X,"^",1),1,22)_"^"_BID_"^"_WARD_"^"_RM_"^"_$P(XY,"^",5,7) Q
|
|
F TF2=0:0 S TF2=$O(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2)) Q:TF2<1 S YY=^(TF2,0) D LP
|
|
Q
|
|
LP S TP=$P(YY,"^",4) D PREP
|
|
I "135"[FHOPT S:'$D(^TMP($J,"C",CNOD,TUN,0)) ^(0)="" S $P(^(0),"^",1)=$P(^(0),"^",1)+TU,$P(^(0),"^",2)=$P(^(0),"^",2)+1
|
|
I "124"[FHOPT S ^TMP($J,"T",TNOD,PNOD,TF2,0)=$P(Y0,"^",1)_"^"_$P(Y0,"^",2)_"^"_TP_"^"_TW_"^"_TU_"^"_P1_"^"_STR_"^"_QUA_"^"_TUN
|
|
Q
|
|
Q3 K ^FHPT("ADTF",FHDFN,ADM)
|
|
I $D(^FHPT(FHDFN,"A",ADM,0)) S TF=$P(^(0),"^",4),$P(^(0),"^",4)="" I TF>0,$D(^FHPT(FHDFN,"A",ADM,"TF",TF,0)) S $P(^(0),"^",11)=NOW,ORIFN=$P(^(0),"^",14) I ORIFN S ORSTS=1 D ST^ORX
|
|
Q
|
|
PREP ; Calculate Preparation
|
|
S TUN=$P(YY,"^",1),Y0=$G(^FH(118.2,TUN,0)) Q:Y0=""
|
|
S STR=$P(YY,"^",2),QUA=$P(YY,"^",3)
|
|
I QUA["CC" S QUAFI=$P(QUA,"CC",1),QUASE=$P(QUA,"CC",2),QUA=QUAFI_"ML"_QUASE
|
|
I $E($P(Y0,"^",3),$L($P(Y0,"^",3)))="G" D GRM Q
|
|
S TU=$P(YY,"^",4)/$S(+$P(Y0,"^",3):+$P(Y0,"^",3),1:9999),TW=$P(YY,"^",5)
|
|
;I TW<6 S TP="",TW="",TU=TU+.75\1,P1=TU Q ;NOIS MWV-0303-21626
|
|
I TW<6 S TP="",TW="",(TU,P1)=TU+.9999\1 Q
|
|
S TU=TU+.2*4\1/4,TP=$J(TP/10,0)*10,TW=$J(TW/10,0)*10
|
|
S P1=$S(TU<1:"",1:TU\1) I TU#1 S:P1 P1=P1_"-" S P2=TU#1,P1=P1_$S(P2<.3:"1/4",P2<.6:"1/2",1:"3/4")
|
|
Q
|
|
GRM ; Calculate Gram
|
|
S TW=0,X=QUA D FIX^FHORT10 S Z5="" F L=1:1:$L(X) I $E(X,L)'=" " S Z5=Z5_$E(X,L)
|
|
S Z5=$P(Z5,"/",2),Z5=$P(Z5,"X",2)
|
|
I 'Z5 S Z5=$P("1,24,2,3,12,8,6,4",",",K) G G1
|
|
I Z5'["F" S Z5=$S(K=1:1,K=2:Z5,K=3:2,K=4:3,K=5:Z5\2,K=6:Z5\3,K=7:Z5\4,1:Z5\6)
|
|
E S:K=1 Z5=1
|
|
G1 S TU=+QUA*Z5
|
|
S TU=TU/$S(+$P(Y0,"^",3):+$P(Y0,"^",3),1:9999)
|
|
;S P1=$S(TU<1:"",1:TU\1) I P1="" S TU=TU+.95\1,P1=TU
|
|
S P1=$S(TU<1:"",1:TU\1)
|
|
I P1="" S TU=TU+.999\1,P1=TU
|
|
E S TU=TU+.999\1
|
|
I TU#1 S:P1 P1=P1_"-" S TU=TU#1,P1=P1_$S(TU<.3:"1/4",TU<.6:"1/2",1:"3/4")
|
|
Q
|