FHORT5B ; HISC/REL/NCA - Tubefeeding Reports (cont) ;5/4/93 10:47
;;5.5;DIETETICS;**1**;Jan 28, 2005
PREP ; Preparation Report
D:SUM HD1 S TNOD="" F S TNOD=$O(^TMP($J,"T",TNOD)) Q:TNOD="" D:'SUM HD1 D A2
Q
A2 S PNOD="" F S PNOD=$O(^TMP($J,"T",TNOD,PNOD)) Q:PNOD="" S X0=^(PNOD,0) D A3
Q
A3 D:$Y>(IOSL-10) HD1 W !,$P(X0,"^",3)," ",$P(X0,"^",4),!,$P(X0,"^",1),?23,$P(X0,"^",2)
F TF2=0:0 S TF2=$O(^TMP($J,"T",TNOD,PNOD,TF2)) Q:'TF2 S X1=^(TF2,0) D A4
S COM=$P(X0,"^",5) W:COM'="" ?66,COM,! Q
A4 W ?31,$E($P(X1,"^",1),1,29) S STR=$P(X1,"^",7) W ?61,$S(STR=4:"Full",STR=2:"1/2",STR=1:"1/4",1:"3/4")
W ?66,$P(X1,"^",8),?101,$P(X1,"^",2),?110,$P(X1,"^",6)
S TW=$P(X1,"^",4) I TW W ?117,$J($P(X1,"^",3),5),?126,$J(TW,4)
W ! Q
HD1 ; Preparation Header
W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
W !,DTP,?39,"P R E P A R A T I O N O F T U B E F E E D I N G S",?125,"Page ",PG
S Y=$S(SUM:"CONSOLIDATED",1:$P(TNOD,"~",2)) W:Y'="" !!?(131-$L(Y)\2),Y
W !!,?112,"#",?119,"ML",?127,"ML"
W !,"Patient",?24,"ID#",?31,"Product",?61,"Str",?66,"Quantity",?101,"Unit",?110,"Units",?117,"Product",?126,"Water",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORT5B 1138 printed Sep 23, 2025@19:29:58 Page 2
FHORT5B ; HISC/REL/NCA - Tubefeeding Reports (cont) ;5/4/93 10:47
+1 ;;5.5;DIETETICS;**1**;Jan 28, 2005
PREP ; Preparation Report
+1 if SUM
DO HD1
SET TNOD=""
FOR
SET TNOD=$ORDER(^TMP($JOB,"T",TNOD))
if TNOD=""
QUIT
if 'SUM
DO HD1
DO A2
+2 QUIT
A2 SET PNOD=""
FOR
SET PNOD=$ORDER(^TMP($JOB,"T",TNOD,PNOD))
if PNOD=""
QUIT
SET X0=^(PNOD,0)
DO A3
+1 QUIT
A3 if $Y>(IOSL-10)
DO HD1
WRITE !,$PIECE(X0,"^",3)," ",$PIECE(X0,"^",4),!,$PIECE(X0,"^",1),?23,$PIECE(X0,"^",2)
+1 FOR TF2=0:0
SET TF2=$ORDER(^TMP($JOB,"T",TNOD,PNOD,TF2))
if 'TF2
QUIT
SET X1=^(TF2,0)
DO A4
+2 SET COM=$PIECE(X0,"^",5)
if COM'=""
WRITE ?66,COM,!
QUIT
A4 WRITE ?31,$EXTRACT($PIECE(X1,"^",1),1,29)
SET STR=$PIECE(X1,"^",7)
WRITE ?61,$SELECT(STR=4:"Full",STR=2:"1/2",STR=1:"1/4",1:"3/4")
+1 WRITE ?66,$PIECE(X1,"^",8),?101,$PIECE(X1,"^",2),?110,$PIECE(X1,"^",6)
+2 SET TW=$PIECE(X1,"^",4)
IF TW
WRITE ?117,$JUSTIFY($PIECE(X1,"^",3),5),?126,$JUSTIFY(TW,4)
+3 WRITE !
QUIT
HD1 ; Preparation Header
+1 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET PG=PG+1
+2 WRITE !,DTP,?39,"P R E P A R A T I O N O F T U B E F E E D I N G S",?125,"Page ",PG
+3 SET Y=$SELECT(SUM:"CONSOLIDATED",1:$PIECE(TNOD,"~",2))
if Y'=""
WRITE !!?(131-$LENGTH(Y)\2),Y
+4 WRITE !!,?112,"#",?119,"ML",?127,"ML"
+5 WRITE !,"Patient",?24,"ID#",?31,"Product",?61,"Str",?66,"Quantity",?101,"Unit",?110,"Units",?117,"Product",?126,"Water",!
+6 QUIT
