- FHDMP3 ; HISC/REL/NCA - Patient Data Log (cont) ;4/30/92 10:15
- ;;5.5;DIETETICS;;Jan 28, 2005
- D:$Y>(S1-4) HDR^FHDMP G:QT="^" KIL^FHDMP W !,LN,!?19,"S U P P L E M E N T A L F E E D I N G S" S LST=1
- I SDT F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"SF",KK)) Q:KK<1 S D1=$P(^(KK,0),"^",2) Q:D1=""!(D1'<SDT) S LST=KK
- S CT=0 F NO=LST-1:0 S NO=$O(^FHPT(FHDFN,"A",ADM,"SF",NO)) Q:NO<1 I $D(^(NO,0)) S X=^(0) D:$Y>(S1-10) HDR^FHDMP G:QT="^" KIL^FHDMP D LIS
- I 'CT W !!,"No Supplemental Feedings for this Admission"
- W ! G ^FHDMP4
- LIS S CT=CT+1 W !!,"Order: ",?11,NO S Y=$P(X,"^",4) W ?40,"Menu: ",$P($G(^FH(118.1,+Y,0)),"^",1)
- S Y=$P(X,"^",2) W !,"Ordered: " D DTP S Y=$P(X,"^",3) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
- S Y=$P(X,"^",30) W !,"Reviewed: " D DTP S Y=$P(X,"^",31) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
- S Y=$P(X,"^",32) W !,"Cancelled: " D DTP S Y=$P(X,"^",33) W ?40,"By: ",$P($G(^VA(200,+Y,0)),"^",1)
- S Y=$P(X,"^",29) W !,"Type: ",?11,$S(Y="D":"Dietary",Y="T":"Therapeutic",1:"") S Y=$P(X,"^",34) W ?40,"Diet Associated: ",$S(Y="Y":"Yes",1:"No")
- K N S L=4 F K1=1:1:3 S K=0,N(K1)="" F K2=1:1:4 S Z=$P(X,"^",L+1),Q=$P(X,"^",L+2),L=L+2 I Z'="" S:'Q Q=1 S:N(K1)'="" N(K1)=N(K1)_"; " S N(K1)=N(K1)_Q_" "_$P($G(^FH(118,Z,0)),"^",1)
- F K1=1:1:3 I N(K1)'="" W !,$P("10 Am; 2 Pm; 8 Pm",";",K1),?8,$E(N(K1),1,52)
- 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[HFHDMP3 1607 printed Feb 18, 2025@23:13:58 Page 2
- FHDMP3 ; HISC/REL/NCA - Patient Data Log (cont) ;4/30/92 10:15
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 if $Y>(S1-4)
- DO HDR^FHDMP
- if QT="^"
- GOTO KIL^FHDMP
- WRITE !,LN,!?19,"S U P P L E M E N T A L F E E D I N G S"
- SET LST=1
- +3 IF SDT
- FOR KK=0:0
- SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"SF",KK))
- if KK<1
- QUIT
- SET D1=$PIECE(^(KK,0),"^",2)
- if D1=""!(D1'<SDT)
- QUIT
- SET LST=KK
- +4 SET CT=0
- FOR NO=LST-1:0
- SET NO=$ORDER(^FHPT(FHDFN,"A",ADM,"SF",NO))
- if NO<1
- QUIT
- IF $DATA(^(NO,0))
- SET X=^(0)
- if $Y>(S1-10)
- DO HDR^FHDMP
- if QT="^"
- GOTO KIL^FHDMP
- DO LIS
- +5 IF 'CT
- WRITE !!,"No Supplemental Feedings for this Admission"
- +6 WRITE !
- GOTO ^FHDMP4
- LIS SET CT=CT+1
- WRITE !!,"Order: ",?11,NO
- SET Y=$PIECE(X,"^",4)
- WRITE ?40,"Menu: ",$PIECE($GET(^FH(118.1,+Y,0)),"^",1)
- +1 SET Y=$PIECE(X,"^",2)
- WRITE !,"Ordered: "
- DO DTP
- SET Y=$PIECE(X,"^",3)
- WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
- +2 SET Y=$PIECE(X,"^",30)
- WRITE !,"Reviewed: "
- DO DTP
- SET Y=$PIECE(X,"^",31)
- WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
- +3 SET Y=$PIECE(X,"^",32)
- WRITE !,"Cancelled: "
- DO DTP
- SET Y=$PIECE(X,"^",33)
- WRITE ?40,"By: ",$PIECE($GET(^VA(200,+Y,0)),"^",1)
- +4 SET Y=$PIECE(X,"^",29)
- WRITE !,"Type: ",?11,$SELECT(Y="D":"Dietary",Y="T":"Therapeutic",1:"")
- SET Y=$PIECE(X,"^",34)
- WRITE ?40,"Diet Associated: ",$SELECT(Y="Y":"Yes",1:"No")
- +5 KILL N
- SET L=4
- FOR K1=1:1:3
- SET K=0
- SET N(K1)=""
- FOR K2=1:1:4
- SET Z=$PIECE(X,"^",L+1)
- SET Q=$PIECE(X,"^",L+2)
- SET L=L+2
- IF Z'=""
- if 'Q
- SET Q=1
- if N(K1)'=""
- SET N(K1)=N(K1)_"; "
- SET N(K1)=N(K1)_Q_" "_$PIECE($GET(^FH(118,Z,0)),"^",1)
- +6 FOR K1=1:1:3
- IF N(K1)'=""
- WRITE !,$PIECE("10 Am; 2 Pm; 8 Pm",";",K1),?8,$EXTRACT(N(K1),1,52)
- +7 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