source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHDCR1C.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1FHDCR1C ; HISC/NCA/RVD - Print Diet Cards (cont.) ;5/10/95 13:02
2 ;;5.5;DIETETICS;;Jan 28, 2005
3PRT ; Print 2 person page
4 N NBR
5 S TL=0 D CHKH
6 W !! S TL=TL+2 F N1=1:1:2 I $D(^TMP($J,0,N1)) W ?$S(N1=1:2,1:65),MEALDT
7 W ! S TL=TL+1 F N1=1:1 Q:'$D(PP(N1)) W ! S TL=TL+1 F NBR=1:1:2 I $D(PP(N1,NBR)) W ?$S(NBR=1:2,1:65),PP(N1,NBR)
8 W ! S TL=TL+1
9 F N1=1:1 Q:'$D(^TMP($J,"MP",N1)) D:(TL+2)'<($S(FHBOT="Y":LN-5,1:LN-3)) NXT W !! S TL=TL+2 F NBR=1:1:2 D
10 .S S1=$S(NBR=1:2,1:65)
11 .I $D(^TMP($J,"MP",N1,NBR)) W ?S1,^TMP($J,"MP",N1,NBR)
12 .Q
13 I TL<LN F L1=TL:1:$S(FHBOT="Y":LN-2,1:LN) W !
14 I FHBOT="Y" D HEAD W @IOF Q
15 E D FOOT
16 W @IOF Q
17NXT ; Print Next Page
18 W !! S TL=TL+2 F NM=1:1:2 I $D(^TMP($J,0,NM)) W ?$S(NM=1:20,1:80),"(More Items Next Pg)"
19 I TL<LN F L1=TL:1:$S(FHBOT="Y":LN-2,1:LN) W !
20 I FHBOT="Y" D HEAD G N1
21 E D FOOT
22N1 W @IOF S TL=0 D CHKH
23 W !! S TL=TL+2 F XX=1:1:2 I $D(^TMP($J,0,XX)) W ?$S(XX=1:2,1:65),MEALDT," (Cont.)"
24 W ! S TL=TL+1
25 Q
26CHKH ; Check whether name header should be on bottom
27 I FHBOT="Y" W ! S TL=TL+1 D FOOT W ! S TL=TL+1 Q
28 E D HEAD
29 Q
30HEAD F NM=1:1:3 W ! S TL=TL+1 F NBR=1:1:2 S X=$P($G(^TMP($J,0,NBR)),"^",NM) I X'="" D
31 .S S1=$S(NBR=1:2,1:65) I NM=1 W ?S1,X Q
32 .W ?(S1+56-$L(X)),X Q
33 Q
34FOOT W ! S TL=TL+1 F NBR=1:1:2 S S1=$S(NBR=1:2,1:65) W:$D(^TMP($J,0,NBR)) ?S1,HD
35 Q
Note: See TracBrowser for help on using the repository browser.