- FHPRF4 ; HISC/REL - Print Other Meals ;4/27/93 13:41
- ;;5.5;DIETETICS;;Jan 28, 2005
- R1 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
- I $D(IO("Q")) S FHPGM="Q1^FHPRF4",FHLST="" D EN2^FH G KIL
- U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
- Q1 ; Print Other Meals
- D NOW^%DTC S DTP=% D DTP^FH
- W:$E(IOST,1,2)="C-" @IOF W !?29,"O T H E R M E A L S"
- W !!?(79-$L(DTP)\2),DTP
- F P0=0:0 S P0=$O(^FH(119.72,P0)) Q:P0<1 S X1=0 F NX=0:0 S NX=$O(^FH(119.72,P0,"B",NX)) Q:NX<1 S X=^(NX,0) D PR
- W ! Q
- PR I $G(^FH(119.72,P0,"I"))="Y" Q
- G:X1 P1 S Y=$P(^FH(119.72,P0,0),"^",1),X1=1 W !!?(79-$L(Y)\2),Y
- W !!,"Diet",?32,"Meal",?40,"Sun Mon Tue Wed Thu Fri Sat"
- P1 S NAM=$P(^FH(116.2,NX,0),"^",1) W !!,NAM
- F L=1:1:3 W:L>1 ! W ?32,$P("Brk^Noon^Even","^",L),?38 F K=1:1:7 S Z=$P(X,"^",K*3-2+L) W $S('Z:$J("",5),1:$J(Z,5))
- Q
- KIL G KILL^XUSCLEAN
- FHPRF4 ; HISC/REL - Print Other Meals ;4/27/93 13:41
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- R1 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select LIST Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- IF POP
- GOTO KIL
- +1 IF $DATA(IO("Q"))
- SET FHPGM="Q1^FHPRF4"
- SET FHLST=""
- DO EN2^FH
- GOTO KIL
- +2 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- Q1 ; Print Other Meals
- +1 DO NOW^%DTC
- SET DTP=%
- DO DTP^FH
- +2 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?29,"O T H E R M E A L S"
- +3 WRITE !!?(79-$LENGTH(DTP)\2),DTP
- +4 FOR P0=0:0
- SET P0=$ORDER(^FH(119.72,P0))
- IF P0<1
- QUIT
- SET X1=0
- FOR NX=0:0
- SET NX=$ORDER(^FH(119.72,P0,"B",NX))
- IF NX<1
- QUIT
- SET X=^(NX,0)
- DO PR
- +5 WRITE !
- QUIT
- PR IF $GET(^FH(119.72,P0,"I"))="Y"
- QUIT
- +1 IF X1
- GOTO P1
- SET Y=$PIECE(^FH(119.72,P0,0),"^",1)
- SET X1=1
- WRITE !!?(79-$LENGTH(Y)\2),Y
- +2 WRITE !!,"Diet",?32,"Meal",?40,"Sun Mon Tue Wed Thu Fri Sat"
- P1 SET NAM=$PIECE(^FH(116.2,NX,0),"^",1)
- WRITE !!,NAM
- +1 FOR L=1:1:3
- IF L>1
- WRITE !
- WRITE ?32,$PIECE("Brk^Noon^Even","^",L),?38
- FOR K=1:1:7
- SET Z=$PIECE(X,"^",K*3-2+L)
- WRITE $SELECT('Z:$JUSTIFY("",5),1:$JUSTIFY(Z,5))
- +2 QUIT
- KIL GOTO KILL^XUSCLEAN
