FHDMP5 ; HISC/REL/NCA - Patient Data Log (cont) ;2/17/93 16:23
;;5.5;DIETETICS;;Jan 28, 2005
D:$Y>(S1-4) HDR^FHDMP G:QT="^" KIL^FHDMP W !,LN,!?25,"S T A N D I N G O R D E R S"
S CT=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SP",K)) Q:K<1 I $D(^(K,0)) S X=^(0) I $P(X,"^",4)'<SDT D:$Y>(S1-6) HDR^FHDMP G:QT="^" KIL^FHDMP D SP
I 'CT W !!,"No Standing Orders for this Admission"
W !
D:$Y>(S1-4) HDR^FHDMP G:QT="^" KIL^FHDMP W !,LN,!?23,"A D D I T I O N A L O R D E R S"
S CT=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"OO",K)) Q:K<1 I $D(^(K,0)) S X=^(0) I $P(X,"^",2)'<SDT D:$Y>(S1-6) HDR^FHDMP G:QT="^" KIL^FHDMP D L1
I 'CT W !!,"No Additional Orders for this Admission"
W ! Q
SP S CT=CT+1 W !!,"Order #: ",K
S M1=$P(X,"^",3) I M1="BNE" S M2="All Meals" G S1
S L=$E(M1,1),M2=$S(L="B":"Break",L="N":"Noon",1:"Even")
S L=$E(M1,2) I L'="" S M2=M2_","_$S(L="B":"Break",L="N":"Noon",1:"Even")
S1 W ?40,"Meals: ",M2
S Y=$P(X,"^",2),Q=$P(X,"^",8) W !,"Order: ",$S(Q:Q,1:1)," ",$P($G(^FH(118.3,+Y,0)),"^",1)
S Y=$P(X,"^",4) W !,"Ordered: " D DTP S Y=$P(X,"^",5) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
S Y=$P(X,"^",6) W !,"Cancelled: " D DTP S Y=$P(X,"^",7) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
S Y=$P(X,"^",9) W !,"Diet Associated: ",$S(Y="Y":"Yes",1:"No") Q
L1 S CT=CT+1 W !!,"Order #: ",K S Y=$P(X,"^",5) W ?40,"Status: ",$S(Y="C":"Complete",Y="A":"Active",Y="S":"Saved",Y="X":"Cancelled",1:"")
W !,"Order: ",$P(X,"^",3)
S Y=$P(X,"^",2) W !,"Ordered: " D DTP S Y=$P(X,"^",4) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
S Y=$P(X,"^",6) W !,"Cleared: " D DTP S Y=$P(X,"^",7) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1) Q
DTP ; Printable Date/Time
Q:Y<1 W $J(+$E(Y,6,7),2)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(Y,4,5))_"-"_$E(Y,2,3)
I Y["." S %=+$E(Y_"0",9,10) W $J($S(%>12:%-12,1:%),3)_":"_$E(Y_"000",11,12)_$S(%<12:"am",%<24:"pm",1:"m")
K % Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHDMP5 1941 printed Dec 13, 2024@01:47:37 Page 2
FHDMP5 ; HISC/REL/NCA - Patient Data Log (cont) ;2/17/93 16:23
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 if $Y>(S1-4)
DO HDR^FHDMP
if QT="^"
GOTO KIL^FHDMP
WRITE !,LN,!?25,"S T A N D I N G O R D E R S"
+3 SET CT=0
FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"SP",K))
if K<1
QUIT
IF $DATA(^(K,0))
SET X=^(0)
IF $PIECE(X,"^",4)'<SDT
if $Y>(S1-6)
DO HDR^FHDMP
if QT="^"
GOTO KIL^FHDMP
DO SP
+4 IF 'CT
WRITE !!,"No Standing Orders for this Admission"
+5 WRITE !
+6 if $Y>(S1-4)
DO HDR^FHDMP
if QT="^"
GOTO KIL^FHDMP
WRITE !,LN,!?23,"A D D I T I O N A L O R D E R S"
+7 SET CT=0
FOR K=0:0
SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"OO",K))
if K<1
QUIT
IF $DATA(^(K,0))
SET X=^(0)
IF $PIECE(X,"^",2)'<SDT
if $Y>(S1-6)
DO HDR^FHDMP
if QT="^"
GOTO KIL^FHDMP
DO L1
+8 IF 'CT
WRITE !!,"No Additional Orders for this Admission"
+9 WRITE !
QUIT
SP SET CT=CT+1
WRITE !!,"Order #: ",K
+1 SET M1=$PIECE(X,"^",3)
IF M1="BNE"
SET M2="All Meals"
GOTO S1
+2 SET L=$EXTRACT(M1,1)
SET M2=$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
+3 SET L=$EXTRACT(M1,2)
IF L'=""
SET M2=M2_","_$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
S1 WRITE ?40,"Meals: ",M2
+1 SET Y=$PIECE(X,"^",2)
SET Q=$PIECE(X,"^",8)
WRITE !,"Order: ",$SELECT(Q:Q,1:1)," ",$PIECE($GET(^FH(118.3,+Y,0)),"^",1)
+2 SET Y=$PIECE(X,"^",4)
WRITE !,"Ordered: "
DO DTP
SET Y=$PIECE(X,"^",5)
WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
+3 SET Y=$PIECE(X,"^",6)
WRITE !,"Cancelled: "
DO DTP
SET Y=$PIECE(X,"^",7)
WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
+4 SET Y=$PIECE(X,"^",9)
WRITE !,"Diet Associated: ",$SELECT(Y="Y":"Yes",1:"No")
QUIT
L1 SET CT=CT+1
WRITE !!,"Order #: ",K
SET Y=$PIECE(X,"^",5)
WRITE ?40,"Status: ",$SELECT(Y="C":"Complete",Y="A":"Active",Y="S":"Saved",Y="X":"Cancelled",1:"")
+1 WRITE !,"Order: ",$PIECE(X,"^",3)
+2 SET Y=$PIECE(X,"^",2)
WRITE !,"Ordered: "
DO DTP
SET Y=$PIECE(X,"^",4)
WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
+3 SET Y=$PIECE(X,"^",6)
WRITE !,"Cleared: "
DO DTP
SET Y=$PIECE(X,"^",7)
WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
QUIT
DTP ; Printable Date/Time
+1 if Y<1
QUIT
WRITE $JUSTIFY(+$EXTRACT(Y,6,7),2)_"-"_$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$EXTRACT(Y,4,5))_"-"_$EXTRACT(Y,2,3)
+2 IF Y["."
SET %=+$EXTRACT(Y_"0",9,10)
WRITE $JUSTIFY($SELECT(%>12:%-12,1:%),3)_":"_$EXTRACT(Y_"000",11,12)_$SELECT(%<12:"am",%<24:"pm",1:"m")
+3 KILL %
QUIT
