- FHORD83 ; HISC/REL/NCA/JH - Diet Order Lists (cont.) ;7/31/96 11:37
- ;;5.5;DIETETICS;;Jan 28, 2005
- DISP ; Display Patient Food Preference
- I ($Y>(IOSL-6)) D HDR^FHORD81,FLNE^FHORD82
- W !!?26,"Likes",?58,"DisLikes",!!
- K P S P1=1 F K=0:0 S K=$O(^FHPT(FHDFN,"P",K)) Q:K<1 S X=^(K,0) D FP
- S (M,MM)="" F S M=$O(P(M)) Q:M="" D S MM=M
- .I $D(P(M)) D
- ..I ($Y>(IOSL-6)) D HDR^FHORD81,FLNE^FHORD82 W !!?26,"Likes",?58,"Dislikes",!!
- ..W ?13,$P(M,"~",2) S (P1,P2)=0 F S:P1'="" P1=$O(P(M,"L",P1)) S X1=$S(P1'="":P(M,"L",P1),1:"") S:P2'="" P2=$O(P(M,"D",P2)) S X2=$S(P2'="":P(M,"D",P2),1:"") Q:P1=""&(P2="") D P0 W:MM'=M !
- ..Q
- .Q
- I $O(P(""))="" W !?13,"No Food Preferences on file",!
- Q
- P0 I X1'="" W ?25 S X=X1 D P1 S X1=X
- I X2'="" W ?52 S X=X2 D P1 S X2=X
- Q:X1=""&(X2="") W ! G P0
- P1 I $L(X)<27 W X S X="" Q
- F KK=28:-1:1 Q:$E(X,KK-1,KK)=", "
- I KK=1 S KK=26 W $E(X,1,KK) S X=$E(X,KK+1,999) Q
- I $Y>(IOSL-6) D HDR^FHORD81
- W $E(X,1,KK-2) S X=$E(X,KK+1,999) Q
- FP Q:'$P(X,U) S M1=$P(X,"^",2) Q:M1="" S:M1="A" M1="BNE" S Z=$G(^FH(115.2,+X,0)) Q:$P(Z,U)=""!($P(Z,U,2)="") S L1=$P(Z,"^",1),KK=$P(Z,"^",2),M="",DAS=$P(X,"^",4)
- I KK="L" S Q=$P(X,"^",3),L1=$S(Q:Q,1:1)_" "_L1
- I M1="BNE" S M="1~All Meals" G FP1
- S Z1=$E(M1,1) I Z1'="" S M=$S(Z1="B":"2~Break",Z1="N":"3~Noon",1:"4~Even")
- S Z1=$E(M1,2) I Z1'="" S M=M_","_$S(Z1="B":"Break",Z1="N":"Noon",1:"Even")
- FP1 S:'$D(P(M,KK,P1)) P(M,KK,P1)="" I $L(P(M,KK,P1))+$L(L1)<255 S P(M,KK,P1)=P(M,KK,P1)_$S(P(M,KK,P1)="":"",1:", ")_L1_$S(DAS="Y":" (D)",1:"")
- E S:'$D(P(M,KK,K)) P(M,KK,K)="" S P(M,KK,K)=L1_$S(DAS="Y":" (D)",1:"") S P1=K
- Q
- FHORD83 ; HISC/REL/NCA/JH - Diet Order Lists (cont.) ;7/31/96 11:37
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- DISP ; Display Patient Food Preference
- +1 IF ($Y>(IOSL-6))
- DO HDR^FHORD81
- DO FLNE^FHORD82
- +2 WRITE !!?26,"Likes",?58,"DisLikes",!!
- +3 KILL P
- SET P1=1
- FOR K=0:0
- SET K=$ORDER(^FHPT(FHDFN,"P",K))
- IF K<1
- QUIT
- SET X=^(K,0)
- DO FP
- +4 SET (M,MM)=""
- FOR
- SET M=$ORDER(P(M))
- IF M=""
- QUIT
- Begin DoDot:1
- +5 IF $DATA(P(M))
- Begin DoDot:2
- +6 IF ($Y>(IOSL-6))
- DO HDR^FHORD81
- DO FLNE^FHORD82
- WRITE !!?26,"Likes",?58,"Dislikes",!!
- +7 WRITE ?13,$PIECE(M,"~",2)
- SET (P1,P2)=0
- FOR
- IF P1'=""
- SET P1=$ORDER(P(M,"L",P1))
- SET X1=$SELECT(P1'="":P(M,"L",P1),1:"")
- IF P2'=""
- SET P2=$ORDER(P(M,"D",P2))
- SET X2=$SELECT(P2'="":P(M,"D",P2),1:"")
- IF P1=""&(P2="")
- QUIT
- DO P0
- IF MM'=M
- WRITE !
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- SET MM=M
- +10 IF $ORDER(P(""))=""
- WRITE !?13,"No Food Preferences on file",!
- +11 QUIT
- P0 IF X1'=""
- WRITE ?25
- SET X=X1
- DO P1
- SET X1=X
- +1 IF X2'=""
- WRITE ?52
- SET X=X2
- DO P1
- SET X2=X
- +2 IF X1=""&(X2="")
- QUIT
- WRITE !
- GOTO P0
- P1 IF $LENGTH(X)<27
- WRITE X
- SET X=""
- QUIT
- +1 FOR KK=28:-1:1
- IF $EXTRACT(X,KK-1,KK)=", "
- QUIT
- +2 IF KK=1
- SET KK=26
- WRITE $EXTRACT(X,1,KK)
- SET X=$EXTRACT(X,KK+1,999)
- QUIT
- +3 IF $Y>(IOSL-6)
- DO HDR^FHORD81
- +4 WRITE $EXTRACT(X,1,KK-2)
- SET X=$EXTRACT(X,KK+1,999)
- QUIT
- FP IF '$PIECE(X,U)
- QUIT
- SET M1=$PIECE(X,"^",2)
- IF M1=""
- QUIT
- IF M1="A"
- SET M1="BNE"
- SET Z=$GET(^FH(115.2,+X,0))
- IF $PIECE(Z,U)=""!($PIECE(Z,U,2)="")
- QUIT
- SET L1=$PIECE(Z,"^",1)
- SET KK=$PIECE(Z,"^",2)
- SET M=""
- SET DAS=$PIECE(X,"^",4)
- +1 IF KK="L"
- SET Q=$PIECE(X,"^",3)
- SET L1=$SELECT(Q:Q,1:1)_" "_L1
- +2 IF M1="BNE"
- SET M="1~All Meals"
- GOTO FP1
- +3 SET Z1=$EXTRACT(M1,1)
- IF Z1'=""
- SET M=$SELECT(Z1="B":"2~Break",Z1="N":"3~Noon",1:"4~Even")
- +4 SET Z1=$EXTRACT(M1,2)
- IF Z1'=""
- SET M=M_","_$SELECT(Z1="B":"Break",Z1="N":"Noon",1:"Even")
- FP1 IF '$DATA(P(M,KK,P1))
- SET P(M,KK,P1)=""
- IF $LENGTH(P(M,KK,P1))+$LENGTH(L1)<255
- SET P(M,KK,P1)=P(M,KK,P1)_$SELECT(P(M,KK,P1)="":"",1:", ")_L1_$SELECT(DAS="Y":" (D)",1:"")
- +1 IF '$TEST
- IF '$DATA(P(M,KK,K))
- SET P(M,KK,K)=""
- SET P(M,KK,K)=L1_$SELECT(DAS="Y":" (D)",1:"")
- SET P1=K
- +2 QUIT
