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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORT5A 5438 printed Nov 22, 2024@17:04:08 Page 2
FHORT5A ; HISC/REL/NCA/RVD - Tubefeeding Reports (cont) ;3/1/04 13:15
+1 ;;5.5;DIETETICS;**1,3,5**;Jan 28, 2005;Build 53
+2 ;
Q1 ; Print Tubefeeding Report
+1 SET PG=0
DO NOW^%DTC
SET (DTP,NOW)=%
DO DTP^FH
KILL ^TMP($JOB)
INPAT ;get inpatient data
+1 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("ADTF",FHDFN))
if FHDFN<1
QUIT
FOR ADM=0:0
SET ADM=$ORDER(^FHPT("ADTF",FHDFN,ADM))
if ADM<1
QUIT
DO PATNAME^FHOMUTL
if DFN=""
QUIT
DO Q2
+2 ;
OUTPAT ;get outpatient data, for today's date.
+1 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("RM",DT,FHDFN))
if FHDFN'>0
QUIT
FOR FHFIN=0:0
SET FHFIN=$ORDER(^FHPT("RM",DT,FHDFN,FHFIN))
if FHFIN'>0
QUIT
Begin DoDot:1
+2 ;quit if TF is cancelled
+3 IF $DATA(^FHPT(FHDFN,"OP",FHFIN,3))
IF $PIECE(^(3),U,5)="C"
QUIT
+4 SET (FHRMB,RM)=" "
+5 IF $DATA(^FHPT(FHDFN,"OP",FHFIN,0))
SET FHRMB=$PIECE($GET(^FHPT(FHDFN,"OP",FHFIN,0)),U,18)
+6 IF $GET(FHRMB)
IF $DATA(^DG(405.4,FHRMB,0))
SET RM=$PIECE(^DG(405.4,FHRMB,0),U,1)
+7 FOR FHTF=0:0
SET FHTF=$ORDER(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF))
if FHTF'>0
QUIT
Begin DoDot:2
+8 if '$DATA(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF,0))
QUIT
+9 SET YY=$GET(^FHPT(FHDFN,"OP",FHFIN,"TF",FHTF,0))
+10 ;
+11 SET TF2=FHTF
+12 SET Z=$GET(^FHPT(FHDFN,"OP",FHFIN,0))
+13 SET XY=$GET(^FHPT(FHDFN,"OP",FHFIN,3))
+14 SET (Z1,Z2)=""
SET W1=$PIECE(Z,"^",3)
+15 SET P0=$GET(^FH(119.6,+W1,0))
SET Z3=$PIECE(P0,"^",8)
SET WARD=$EXTRACT($PIECE(P0,"^",1),U,12)
+16 SET CC=$PIECE($GET(^FH(119.73,+Z3,0)),"^",1)
+17 IF FHXX="C"
SET D2=$PIECE(P0,"^",8)
IF FHP
IF FHP'=D2
QUIT
+18 IF FHXX="L"
IF FHP
IF FHP'=W1
QUIT
+19 SET P0=$PIECE(P0,"^",4)
SET P0=$SELECT(P0<1:99,P0<10:"0"_P0,1:P0)
+20 SET TNOD=$SELECT(FHXX="C":"99~"_CC,1:P0_"~"_WARD)
SET CNOD=$SELECT('SUM:TNOD,1:"0")
+21 ;
+22 IF FHOPT=3
Begin DoDot:3
+23 SET CTR=$GET(^TMP($JOB,"C",CNOD,0))
+24 ;I "^^^^"[FHOR S:Z2 $P(CTR,"^",1)=$P(CTR,"^",1)+1 S:Z2 $P(CTR,"^",3)=$P(CTR,"^",3)+1
+25 SET $PIECE(CTR,"^",1)=$PIECE(CTR,"^",1)+1
+26 ;I "^^^^"'[FHOR,Z1="T" S:'Z2 $P(CTR,"^",2)=$P(CTR,"^",2)+1 S:Z2 $P(CTR,"^",4)=$P(CTR,"^",4)+1
+27 SET ^TMP($JOB,"C",CNOD,0)=CTR
QUIT
End DoDot:3
+28 ;
+29 SET TP=$PIECE(YY,"^",4)
DO PREP
+30 ;set ^tmp global for specific report.
+31 DO PATNAME^FHOMUTL
+32 SET PNOD=P0_"~"_WARD_"~"_FHDFN
+33 IF "135"[FHOPT
if '$DATA(^TMP($JOB,"C",CNOD,TUN,0))
SET ^(0)=""
SET $PIECE(^(0),"^",1)=$PIECE(^(0),"^",1)+TU
SET $PIECE(^(0),"^",2)=$PIECE(^(0),"^",2)+1
+34 IF "124"[FHOPT
Begin DoDot:3
+35 if '$DATA(^TMP($JOB,"T",TNOD,PNOD,0))
SET ^(0)=$EXTRACT(FHPTNM,1,22)_"^"_FHBID_"^"_WARD_"^"_RM_"^"_$PIECE(XY,"^",1,3)
+36 SET ^TMP($JOB,"T",TNOD,PNOD,TF2,0)=$PIECE(Y0,"^",1)_"^"_$PIECE(Y0,"^",2)_"^"_TP_"^"_TW_"^"_TU_"^"_P1_"^"_STR_"^"_QUA_"^"_TUN
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
PRT ;prints corresponding reports.
+1 IF FHOPT=1
DO PREP^FHORT5B
DO PULL^FHORT5C
DO DEL^FHORT5C
QUIT
+2 IF FHOPT=2
DO PREP^FHORT5B
QUIT
+3 IF FHOPT=3
DO CST^FHORT5D
QUIT
+4 IF FHOPT=4
DO LAB^FHORT5D
QUIT
+5 IF FHOPT=5
DO PULL^FHORT5C
+6 QUIT
Q2 SET Z=$GET(^FHPT(FHDFN,"A",ADM,0))
SET WARD=$PIECE(Z,"^",8)
if WARD
SET WARD=$PIECE($GET(^FH(119.6,WARD,0)),"^",1)
IF WARD=""
GOTO Q3
+1 if '$DATA(^DPT(DFN,.1))
GOTO Q3
SET CADM=$GET(^DPT("CN",^DPT(DFN,.1),DFN))
if ADM'=CADM
GOTO Q3
+2 SET TF=$PIECE(Z,"^",4)
if TF<1
GOTO Q3
+3 SET Z1=$PIECE(Z,"^",5)
SET Z2=$PIECE(Z,"^",7)
SET W1=$PIECE(Z,"^",8)
SET P0=$GET(^FH(119.6,+W1,0))
SET Z3=$PIECE(P0,"^",8)
SET CC=$PIECE($GET(^FH(119.73,+Z3,0)),"^",1)
+4 IF FHXX="C"
SET D2=$PIECE(P0,"^",8)
IF FHP
IF FHP'=D2
QUIT
+5 IF FHXX="L"
IF FHP
IF FHP'=W1
QUIT
+6 SET P0=$PIECE(P0,"^",4)
SET P0=$SELECT(P0<1:99,P0<10:"0"_P0,1:P0)
+7 SET TNOD=$SELECT(FHXX="C":"99~"_CC,1:P0_"~"_WARD)
SET CNOD=$SELECT('SUM:TNOD,1:"0")
+8 DO CUR^FHORD7
IF FHLD="P"
QUIT
+9 IF FHOPT=3
Begin DoDot:1
+10 SET CTR=$GET(^TMP($JOB,"C",CNOD,0))
+11 IF "^^^^"[FHOR
if 'Z2
SET $PIECE(CTR,"^",1)=$PIECE(CTR,"^",1)+1
if Z2
SET $PIECE(CTR,"^",3)=$PIECE(CTR,"^",3)+1
+12 IF "^^^^"'[FHOR
IF Z1="T"
if 'Z2
SET $PIECE(CTR,"^",2)=$PIECE(CTR,"^",2)+1
if Z2
SET $PIECE(CTR,"^",4)=$PIECE(CTR,"^",4)+1
+13 SET ^TMP($JOB,"C",CNOD,0)=CTR
QUIT
End DoDot:1
+14 IF "124"[FHOPT
Begin DoDot:1
+15 SET RM=$GET(^DPT(DFN,.101))
+16 SET RI=$GET(^DPT(DFN,.108))
SET RE=$SELECT(RI:$ORDER(^FH(119.6,"AR",+RI,W1,0)),1:"")
+17 SET R0=$SELECT(RE:$PIECE($GET(^FH(119.6,W1,"R",+RE,0)),"^",2),1:"")
+18 SET R0=$SELECT(R0<1:99,R0<10:"0"_R0,1:R0)
+19 SET PNOD=P0_"~"_R0_RM_"~"_DFN
SET X=^DPT(DFN,0)
DO PID^FHDPA
+20 SET XY=^FHPT(FHDFN,"A",ADM,"TF",TF,0)
+21 SET ^TMP($JOB,"T",TNOD,PNOD,0)=$EXTRACT($PIECE(X,"^",1),1,22)_"^"_BID_"^"_WARD_"^"_RM_"^"_$PIECE(XY,"^",5,7)
QUIT
End DoDot:1
+22 FOR TF2=0:0
SET TF2=$ORDER(^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2))
if TF2<1
QUIT
SET YY=^(TF2,0)
DO LP
+23 QUIT
LP SET TP=$PIECE(YY,"^",4)
DO PREP
+1 IF "135"[FHOPT
if '$DATA(^TMP($JOB,"C",CNOD,TUN,0))
SET ^(0)=""
SET $PIECE(^(0),"^",1)=$PIECE(^(0),"^",1)+TU
SET $PIECE(^(0),"^",2)=$PIECE(^(0),"^",2)+1
+2 IF "124"[FHOPT
SET ^TMP($JOB,"T",TNOD,PNOD,TF2,0)=$PIECE(Y0,"^",1)_"^"_$PIECE(Y0,"^",2)_"^"_TP_"^"_TW_"^"_TU_"^"_P1_"^"_STR_"^"_QUA_"^"_TUN
+3 QUIT
Q3 KILL ^FHPT("ADTF",FHDFN,ADM)
+1 IF $DATA(^FHPT(FHDFN,"A",ADM,0))
SET TF=$PIECE(^(0),"^",4)
SET $PIECE(^(0),"^",4)=""
IF TF>0
IF $DATA(^FHPT(FHDFN,"A",ADM,"TF",TF,0))
SET $PIECE(^(0),"^",11)=NOW
SET ORIFN=$PIECE(^(0),"^",14)
IF ORIFN
SET ORSTS=1
DO ST^ORX
+2 QUIT
PREP ; Calculate Preparation
+1 SET TUN=$PIECE(YY,"^",1)
SET Y0=$GET(^FH(118.2,TUN,0))
if Y0=""
QUIT
+2 SET STR=$PIECE(YY,"^",2)
SET QUA=$PIECE(YY,"^",3)
+3 IF QUA["CC"
SET QUAFI=$PIECE(QUA,"CC",1)
SET QUASE=$PIECE(QUA,"CC",2)
SET QUA=QUAFI_"ML"_QUASE
+4 IF $EXTRACT($PIECE(Y0,"^",3),$LENGTH($PIECE(Y0,"^",3)))="G"
DO GRM
QUIT
+5 SET TU=$PIECE(YY,"^",4)/$SELECT(+$PIECE(Y0,"^",3):+$PIECE(Y0,"^",3),1:9999)
SET TW=$PIECE(YY,"^",5)
+6 ;I TW<6 S TP="",TW="",TU=TU+.75\1,P1=TU Q ;NOIS MWV-0303-21626
+7 IF TW<6
SET TP=""
SET TW=""
SET (TU,P1)=TU+.9999\1
QUIT
+8 SET TU=TU+.2*4\1/4
SET TP=$JUSTIFY(TP/10,0)*10
SET TW=$JUSTIFY(TW/10,0)*10
+9 SET P1=$SELECT(TU<1:"",1:TU\1)
IF TU#1
if P1
SET P1=P1_"-"
SET P2=TU#1
SET P1=P1_$SELECT(P2<.3:"1/4",P2<.6:"1/2",1:"3/4")
+10 QUIT
GRM ; Calculate Gram
+1 SET TW=0
SET X=QUA
DO FIX^FHORT10
SET Z5=""
FOR L=1:1:$LENGTH(X)
IF $EXTRACT(X,L)'=" "
SET Z5=Z5_$EXTRACT(X,L)
+2 SET Z5=$PIECE(Z5,"/",2)
SET Z5=$PIECE(Z5,"X",2)
+3 IF 'Z5
SET Z5=$PIECE("1,24,2,3,12,8,6,4",",",K)
GOTO G1
+4 IF Z5'["F"
SET Z5=$SELECT(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)
+5 IF '$TEST
if K=1
SET Z5=1
G1 SET TU=+QUA*Z5
+1 SET TU=TU/$SELECT(+$PIECE(Y0,"^",3):+$PIECE(Y0,"^",3),1:9999)
+2 ;S P1=$S(TU<1:"",1:TU\1) I P1="" S TU=TU+.95\1,P1=TU
+3 SET P1=$SELECT(TU<1:"",1:TU\1)
+4 IF P1=""
SET TU=TU+.999\1
SET P1=TU
+5 IF '$TEST
SET TU=TU+.999\1
+6 IF TU#1
if P1
SET P1=P1_"-"
SET TU=TU#1
SET P1=P1_$SELECT(TU<.3:"1/4",TU<.6:"1/2",1:"3/4")
+7 QUIT
