- FHORT10 ; HISC/REL/NCA - Tubefeeding (cont) ;8/6/96 12:00
- ;;5.5;DIETETICS;**1**;Jan 28, 2005
- E1 S FLG1=0 W ! K DIC S DIC="^FH(118.2,",DIC(0)="AEQM",STR=4,QUA=""
- S DIC("A")="Select Tubefeeding Product: " D ^DIC K DIC G AB:"^"[X!$D(DTOUT),E1:Y<1
- E1A I $D(TUN(+Y)) S STR=$P(TUN(+Y),"^",2),QUA=$P(TUN(+Y),"^",3) S X=QUA D:X'="" FIX S QUA=X S:'STR STR=4
- E G:NO>4 AB S $P(TUN(+Y),"^",1)=+Y,NO=NO+1 W !?5,"Product ",$P($G(^FH(118.2,+Y,0)),"^",1)," added"
- E10 W !,"Product: ",$P($G(^FH(118.2,+Y,0)),"^",1)_"// " R X:DTIME G:'$T!(X=U) AB
- I X="" G E11
- I X="@" K TUN(+Y) S NO=NO-1 W " Product including Strength and Quantity DELETED." S FLG1=1 G MORE
- I X["?" D HELP^FHORTR G E10
- S OLDT=$G(TUN(+Y))
- S Y=$$SRCH^FHORTR(X) I 'Y S Y=+OLDT G E10
- I +Y'=+OLDT D G E1A
- .I '$D(TUN(+Y)) K TUN(+OLDT) W !!,$P($G(^FH(118.2,+OLDT,0)),"^",1)," Replaced With ",$P($G(^FH(118.2,+Y,0)),"^",1)
- .Q
- E11 S T(0)=^FH(118.2,+Y,0),(FLG,FLG1)=0,S2="",TT=+Y
- I $E($P(T(0),"^",3),$L($P(T(0),"^",3)))?1"G" S FLG=1 G F0
- E2 W !,"Strength: (1=1/4, 2=1/2, 3=3/4, 4=FULL): ",STR,"// " R X:DTIME G AB:'$T!(X=U),F0:X=""
- I X'?1N!(X<1)!(X>4) W *7,!!,"Enter 1 to 4 to indicate strength." G E2
- S STR=+X
- F0 W !,"Enter quantity as 2000 K, 100 ML/HOUR, 8 OZ/TID, 500 ML/HR X 16, 20 GRAMS/DAY etc."
- E3 W !,"Quantity: ",$S(QUA:QUA_"// ",1:"") R X:DTIME G:'$T!(X["^") AB S:X="" X=QUA G:"?"[X F5 D TR^FH
- I X=QUA G:STR=$P(TUN(TT),"^",2) MORE
- S (TC,TK,TP,TW)=0
- I $E(X,$L(X))="K" S X=X_"/QD"
- S A1="" F K=1:1:$L(X) S Z=$E(X,K) I Z'=" " S A1=A1_Z
- F K=1:1:$L(A1) Q:$E(A1,K)?1U
- S A2=$E(A1,K,99),A1=+$E(A1,1,K-1)
- I A2?1"G".E,'FLG W *7,!!,"Cannot enter ""GRAMS"" if AMT/UNIT is specified in ML's." G F0
- S A3=$P(A2,"/",2),A2=$P(A2,"/",1)
- I FLG S XX=$F("KCAL CC ML OZ TBSP",A2) I XX W *7,!!,"Enter quantity in powder form when AMT/UNIT is in Grams (e.g., # GMS, 1 PKG, or 1 U/Frequency)." G F0
- D:FLG GRAM F K=1:1:11 S S1=$P("KCAL CC ML OZ UNITS BOTTLES CANS PKG TBSP GMS GRAMS"," ",K) G:$P(S1,A2,1)="" F3
- G F5
- F3 S S1=$S(K=1:1,K<4:2,K=4:3,K=9:5,K>9:6,1:4),A2=$P(A3,"X",1),A3=$P(A3,"X",2)
- G:A2'?1U.E F5 I $L(A2)=1,"DH"'[A2 G F5
- S S2=$F("DAY QD QH HOUR HR BID TID Q2H Q3H Q4H Q6H QID",A2) G:'S2 F5 S S2=$S(S2<8:1,S2<19:2,S2<23:3,S2<27:4,S2<31:5,S2<35:6,S2<39:7,1:8)
- S QUA=A1_" "_$P("KCAL ML OZ UNITS TBSP GM"," ",S1),QUA=QUA_" "_$P($T(F6),";",S2+2)
- S:A3'="" QUA=QUA_" X "_(+A3)_" "_$S(A3["F":"fdgs",1:"hrs")
- I S1=1 S DX=$P(T(0),"^",4) G:'DX F5 S TK=A1,TC=A1/DX*$S(STR=4:1,STR=3:1.333,STR=2:2,1:4)
- I S1=4 S DX=+$P(T(0),"^",3) G:'DX F5 S TC=A1*DX*$S(STR=4:1,STR=3:1.333,STR=2:2,1:4)
- S:S1=2 TC=A1 S:S1=3 TC=A1*29.5 S:S1=5 TC=A1*15 I S1=6 S TC=0,A3=0 G C1
- ML I 'A3 S A3=$P("1,24,2,3,12,8,6,4",",",S2) G C1
- I A3'["F" S A3=$S(S2=1:1,S2=2:A3,S2=3:2,S2=4:3,S2=5:A3\2,S2=6:A3\3,S2=7:A3\4,1:A3\6)
- E S:S2=1 A3=1
- C1 S TC=$J(TC*A3,0,0)
- W !!,"Quantity: ",QUA," -- Total: ",TC," ml"
- I TC>5000 W *7,!!,"WARNING: Total Amount should be between 0 to 5000 ml",!,"Please Edit Tubefeeding and Modify."
- S:TC'<1 TP=$S(STR=4:TC,STR=3:TC*.75,STR=2:TC/2,1:TC/4),TP=$J(TP,0,0),TW=TC-TP
- I S1'=1!(S1'=6) S TK="",DX=$P(T(0),"^",4) I DX S TK=DX*TP,TK=$J(TK,0,0)
- S $P(TUN(TT),"^",2,6)=STR_"^"_QUA_"^"_TP_"^"_TW_"^"_TK G:TC>5000 E1
- MORE R !!,"Enter/Edit another Tubefeeding product ? N// ",ANS:DTIME G:'$T!(ANS="^") AB S:ANS="" ANS="N" S X=ANS D TR^FH S ANS=X
- I $P("YES",ANS,1)'="",$P("NO",ANS,1)'="" W *7,!,"Answer YES to Enter More Products or Edit Existing Product.",!,"Answer NO to End Entering and Editing and Process the Products.",!,"Enter ""^"" will Terminate process." G MORE
- I ANS?1"Y".E D DISP^FHORTR G E1
- I FLG1,'NO S TF=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4) D:TF CAN^FHORT2
- Q
- FIX ; Reset Quantity to parsable string
- S K=$F(X,"fdgs") I K>1 S X=$E(X,1,K-5)_"F"
- S K=$F(X,"hrs") I K>1 S X=$E(X,1,K-5)
- F K=1:1:8 S Z=" "_$P($T(F6),";",K+2) I X[Z G F1
- Q
- F1 S X=$P(X,Z,1)_"/"_$P("QD QH BID TID Q2H Q3H Q4H Q6H"," ",K)_$P(X,Z,2) Q
- GRAM ; Get the Grams for powder form
- Q:$E(A2,1)="G"
- S A1=A1*+$P(T(0),"^",3),A2="GRAM"
- Q
- AB W *7,!!,"Tubefeeding Order TERMINATED - No order entered!" D:FHWF=2 WAIT^FHORD71 S (DFN,FHDFN)="" K TUN Q
- F5 W *7,!!,"Units may be K for Kcals, M for ml's, O for oz. or U for units (e.g., cans)"
- W !,"Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H or Q6H"
- W !,"May also input 100ML/HR X 16 for 16 hours or 100ML/Q3H X 6F for 6 feedings."
- W !,"When feeding is specified, it is taken into account other than the predetermined frequency interval.",!,"If Frequency is ordered per day, the Total ml is always the Units ordered."
- W !,"Valid quantity for powder form product can be ""# GRAMS"" as 20 G, GRAMS",!,"or GMS or as 1 PKG or 1 U and the frequency (e.g.,20 GRAMS/DAY, 1 PKG/TID).",! G F0
- F6 ;;per Day;per Hour;Twice a Day;Three times a Day;Every 2 Hours;Every 3 Hours;Every 4 Hours;Every 6 Hours
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORT10 4867 printed Feb 18, 2025@23:20:15 Page 2
- FHORT10 ; HISC/REL/NCA - Tubefeeding (cont) ;8/6/96 12:00
- +1 ;;5.5;DIETETICS;**1**;Jan 28, 2005
- E1 SET FLG1=0
- WRITE !
- KILL DIC
- SET DIC="^FH(118.2,"
- SET DIC(0)="AEQM"
- SET STR=4
- SET QUA=""
- +1 SET DIC("A")="Select Tubefeeding Product: "
- DO ^DIC
- KILL DIC
- if "^"[X!$DATA(DTOUT)
- GOTO AB
- if Y<1
- GOTO E1
- E1A IF $DATA(TUN(+Y))
- SET STR=$PIECE(TUN(+Y),"^",2)
- SET QUA=$PIECE(TUN(+Y),"^",3)
- SET X=QUA
- if X'=""
- DO FIX
- SET QUA=X
- if 'STR
- SET STR=4
- +1 IF '$TEST
- if NO>4
- GOTO AB
- SET $PIECE(TUN(+Y),"^",1)=+Y
- SET NO=NO+1
- WRITE !?5,"Product ",$PIECE($GET(^FH(118.2,+Y,0)),"^",1)," added"
- E10 WRITE !,"Product: ",$PIECE($GET(^FH(118.2,+Y,0)),"^",1)_"// "
- READ X:DTIME
- if '$TEST!(X=U)
- GOTO AB
- +1 IF X=""
- GOTO E11
- +2 IF X="@"
- KILL TUN(+Y)
- SET NO=NO-1
- WRITE " Product including Strength and Quantity DELETED."
- SET FLG1=1
- GOTO MORE
- +3 IF X["?"
- DO HELP^FHORTR
- GOTO E10
- +4 SET OLDT=$GET(TUN(+Y))
- +5 SET Y=$$SRCH^FHORTR(X)
- IF 'Y
- SET Y=+OLDT
- GOTO E10
- +6 IF +Y'=+OLDT
- Begin DoDot:1
- +7 IF '$DATA(TUN(+Y))
- KILL TUN(+OLDT)
- WRITE !!,$PIECE($GET(^FH(118.2,+OLDT,0)),"^",1)," Replaced With ",$PIECE($GET(^FH(118.2,+Y,0)),"^",1)
- +8 QUIT
- End DoDot:1
- GOTO E1A
- E11 SET T(0)=^FH(118.2,+Y,0)
- SET (FLG,FLG1)=0
- SET S2=""
- SET TT=+Y
- +1 IF $EXTRACT($PIECE(T(0),"^",3),$LENGTH($PIECE(T(0),"^",3)))?1"G"
- SET FLG=1
- GOTO F0
- E2 WRITE !,"Strength: (1=1/4, 2=1/2, 3=3/4, 4=FULL): ",STR,"// "
- READ X:DTIME
- if '$TEST!(X=U)
- GOTO AB
- if X=""
- GOTO F0
- +1 IF X'?1N!(X<1)!(X>4)
- WRITE *7,!!,"Enter 1 to 4 to indicate strength."
- GOTO E2
- +2 SET STR=+X
- F0 WRITE !,"Enter quantity as 2000 K, 100 ML/HOUR, 8 OZ/TID, 500 ML/HR X 16, 20 GRAMS/DAY etc."
- E3 WRITE !,"Quantity: ",$SELECT(QUA:QUA_"// ",1:"")
- READ X:DTIME
- if '$TEST!(X["^")
- GOTO AB
- if X=""
- SET X=QUA
- if "?"[X
- GOTO F5
- DO TR^FH
- +1 IF X=QUA
- if STR=$PIECE(TUN(TT),"^",2)
- GOTO MORE
- +2 SET (TC,TK,TP,TW)=0
- +3 IF $EXTRACT(X,$LENGTH(X))="K"
- SET X=X_"/QD"
- +4 SET A1=""
- FOR K=1:1:$LENGTH(X)
- SET Z=$EXTRACT(X,K)
- IF Z'=" "
- SET A1=A1_Z
- +5 FOR K=1:1:$LENGTH(A1)
- if $EXTRACT(A1,K)?1U
- QUIT
- +6 SET A2=$EXTRACT(A1,K,99)
- SET A1=+$EXTRACT(A1,1,K-1)
- +7 IF A2?1"G".E
- IF 'FLG
- WRITE *7,!!,"Cannot enter ""GRAMS"" if AMT/UNIT is specified in ML's."
- GOTO F0
- +8 SET A3=$PIECE(A2,"/",2)
- SET A2=$PIECE(A2,"/",1)
- +9 IF FLG
- SET XX=$FIND("KCAL CC ML OZ TBSP",A2)
- IF XX
- WRITE *7,!!,"Enter quantity in powder form when AMT/UNIT is in Grams (e.g., # GMS, 1 PKG, or 1 U/Frequency)."
- GOTO F0
- +10 if FLG
- DO GRAM
- FOR K=1:1:11
- SET S1=$PIECE("KCAL CC ML OZ UNITS BOTTLES CANS PKG TBSP GMS GRAMS"," ",K)
- if $PIECE(S1,A2,1)=""
- GOTO F3
- +11 GOTO F5
- F3 SET S1=$SELECT(K=1:1,K<4:2,K=4:3,K=9:5,K>9:6,1:4)
- SET A2=$PIECE(A3,"X",1)
- SET A3=$PIECE(A3,"X",2)
- +1 if A2'?1U.E
- GOTO F5
- IF $LENGTH(A2)=1
- IF "DH"'[A2
- GOTO F5
- +2 SET S2=$FIND("DAY QD QH HOUR HR BID TID Q2H Q3H Q4H Q6H QID",A2)
- if 'S2
- GOTO F5
- SET S2=$SELECT(S2<8:1,S2<19:2,S2<23:3,S2<27:4,S2<31:5,S2<35:6,S2<39:7,1:8)
- +3 SET QUA=A1_" "_$PIECE("KCAL ML OZ UNITS TBSP GM"," ",S1)
- SET QUA=QUA_" "_$PIECE($TEXT(F6),";",S2+2)
- +4 if A3'=""
- SET QUA=QUA_" X "_(+A3)_" "_$SELECT(A3["F":"fdgs",1:"hrs")
- +5 IF S1=1
- SET DX=$PIECE(T(0),"^",4)
- if 'DX
- GOTO F5
- SET TK=A1
- SET TC=A1/DX*$SELECT(STR=4:1,STR=3:1.333,STR=2:2,1:4)
- +6 IF S1=4
- SET DX=+$PIECE(T(0),"^",3)
- if 'DX
- GOTO F5
- SET TC=A1*DX*$SELECT(STR=4:1,STR=3:1.333,STR=2:2,1:4)
- +7 if S1=2
- SET TC=A1
- if S1=3
- SET TC=A1*29.5
- if S1=5
- SET TC=A1*15
- IF S1=6
- SET TC=0
- SET A3=0
- GOTO C1
- ML IF 'A3
- SET A3=$PIECE("1,24,2,3,12,8,6,4",",",S2)
- GOTO C1
- +1 IF A3'["F"
- SET A3=$SELECT(S2=1:1,S2=2:A3,S2=3:2,S2=4:3,S2=5:A3\2,S2=6:A3\3,S2=7:A3\4,1:A3\6)
- +2 IF '$TEST
- if S2=1
- SET A3=1
- C1 SET TC=$JUSTIFY(TC*A3,0,0)
- +1 WRITE !!,"Quantity: ",QUA," -- Total: ",TC," ml"
- +2 IF TC>5000
- WRITE *7,!!,"WARNING: Total Amount should be between 0 to 5000 ml",!,"Please Edit Tubefeeding and Modify."
- +3 if TC'<1
- SET TP=$SELECT(STR=4:TC,STR=3:TC*.75,STR=2:TC/2,1:TC/4)
- SET TP=$JUSTIFY(TP,0,0)
- SET TW=TC-TP
- +4 IF S1'=1!(S1'=6)
- SET TK=""
- SET DX=$PIECE(T(0),"^",4)
- IF DX
- SET TK=DX*TP
- SET TK=$JUSTIFY(TK,0,0)
- +5 SET $PIECE(TUN(TT),"^",2,6)=STR_"^"_QUA_"^"_TP_"^"_TW_"^"_TK
- if TC>5000
- GOTO E1
- MORE READ !!,"Enter/Edit another Tubefeeding product ? N// ",ANS:DTIME
- if '$TEST!(ANS="^")
- GOTO AB
- if ANS=""
- SET ANS="N"
- SET X=ANS
- DO TR^FH
- SET ANS=X
- +1 IF $PIECE("YES",ANS,1)'=""
- IF $PIECE("NO",ANS,1)'=""
- WRITE *7,!,"Answer YES to Enter More Products or Edit Existing Product.",!,"Answer NO to End Entering and Editing and Process the Products.",!,"Enter ""^"" will Terminate process."
- GOTO MORE
- +2 IF ANS?1"Y".E
- DO DISP^FHORTR
- GOTO E1
- +3 IF FLG1
- IF 'NO
- SET TF=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",4)
- if TF
- DO CAN^FHORT2
- +4 QUIT
- FIX ; Reset Quantity to parsable string
- +1 SET K=$FIND(X,"fdgs")
- IF K>1
- SET X=$EXTRACT(X,1,K-5)_"F"
- +2 SET K=$FIND(X,"hrs")
- IF K>1
- SET X=$EXTRACT(X,1,K-5)
- +3 FOR K=1:1:8
- SET Z=" "_$PIECE($TEXT(F6),";",K+2)
- IF X[Z
- GOTO F1
- +4 QUIT
- F1 SET X=$PIECE(X,Z,1)_"/"_$PIECE("QD QH BID TID Q2H Q3H Q4H Q6H"," ",K)_$PIECE(X,Z,2)
- QUIT
- GRAM ; Get the Grams for powder form
- +1 if $EXTRACT(A2,1)="G"
- QUIT
- +2 SET A1=A1*+$PIECE(T(0),"^",3)
- SET A2="GRAM"
- +3 QUIT
- AB WRITE *7,!!,"Tubefeeding Order TERMINATED - No order entered!"
- if FHWF=2
- DO WAIT^FHORD71
- SET (DFN,FHDFN)=""
- KILL TUN
- QUIT
- F5 WRITE *7,!!,"Units may be K for Kcals, M for ml's, O for oz. or U for units (e.g., cans)"
- +1 WRITE !,"Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H or Q6H"
- +2 WRITE !,"May also input 100ML/HR X 16 for 16 hours or 100ML/Q3H X 6F for 6 feedings."
- +3 WRITE !,"When feeding is specified, it is taken into account other than the predetermined frequency interval.",!,"If Frequency is ordered per day, the Total ml is always the Units ordered."
- +4 WRITE !,"Valid quantity for powder form product can be ""# GRAMS"" as 20 G, GRAMS",!,"or GMS or as 1 PKG or 1 U and the frequency (e.g.,20 GRAMS/DAY, 1 PKG/TID).",!
- GOTO F0
- F6 ;;per Day;per Hour;Twice a Day;Three times a Day;Every 2 Hours;Every 3 Hours;Every 4 Hours;Every 6 Hours