Routine: FHPRW3

FHPRW3 ; HISC/REL - List Communication Offices ;4/25/93  14:23

 ;;5.5;DIETETICS;;Jan 28, 2005

 F K1=0:0 S K1=$O(^FH(119.73,K1)) Q:K1'>0  D Q4

Q4 S X=^FH(119.73,K1,0) D BLD,HDR

 S X1=$G(^FH(119.73,K1,1)),X2=$G(^(2))

 F LL=1:1:6 S Y=$P(X2,"^",LL) I Y'="" D MIP^FHSYSP S $P(X2,"^",LL)=Y

 W !!,"Provide Bagged Meals:",?25 S Z=$P(X2,"^",10) W $S(Z="Y":"YES",1:"NO")

 W !!?44,"Breakfast     Noon     Evening",!

 W !,?5,"Meal Time:" W ?46,$J($P(X2,"^",7),6),?57,$J($P(X2,"^",8),6),?67,$J($P(X2,"^",9),6)

 W !!,?5,"Early Time 1:" W ?46,$J($P(X1,"^",1),6),?57,$J($P(X1,"^",7),6),?67,$J($P(X1,"^",13),6)

 W !,?5,"Early Time 2:" W ?46,$J($P(X1,"^",2),6),?57,$J($P(X1,"^",8),6),?67,$J($P(X1,"^",14),6)

 W !,?5,"Early Time 3:" W ?46,$J($P(X1,"^",3),6),?57,$J($P(X1,"^",9),6),?67,$J($P(X1,"^",15),6)

 W !!,?5,"Late Time 1:" W ?46,$J($P(X1,"^",4),6),?57,$J($P(X1,"^",10),6),?67,$J($P(X1,"^",16),6)

 W !,?5,"Late Time 2:" W ?46,$J($P(X1,"^",5),6),?57,$J($P(X1,"^",11),6),?67,$J($P(X1,"^",17),6)

 W !,?5,"Late Time 3:" W ?46,$J($P(X1,"^",6),6),?57,$J($P(X1,"^",12),6),?67,$J($P(X1,"^",18),6)

 W !!,?5,"Late Alarm Begin:" W ?46,$J($P(X2,"^",1),6),?57,$J($P(X2,"^",3),6),?67,$J($P(X2,"^",5),6)

 W !,?5,"Late Alarm End:" W ?46,$J($P(X2,"^",2),6),?57,$J($P(X2,"^",4),6),?67,$J($P(X2,"^",6),6)

 D WRD W ! Q

WRD W !!,"Associated Dietetic Wards:",!

 K P S N=0,NM="" F  S NM=$O(^TMP($J,NM)) Q:NM=""  S N=N+1,P(N)=$P(NM,"~",1)

 I N S (Z,K)=N+1\2 F LL=1:1:Z W !?5,P(LL) S K=K+1 I $D(P(K)) W ?45,P(K)

BLD ; Build temp files

 K ^TMP($J)

 F LL=0:0 S LL=$O(^FH(119.6,LL)) Q:LL<1  S Y=^(LL,0) I $P(Y,"^",8)=K1 D B1

B1 S ^TMP($J,$P(Y,"^",1)_"~"_LL)="" Q

HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,$E(DTP,1,9),?20,"C O M M U N I C A T I O N   O F F I C E",?73,"Page ",PG

 S Y=$P(X,"^",1) W !!?(78-$L(Y)\2),Y

 W !,"-------------------------------------------------------------------------------",! Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHPRW3   1931     printed  Feb 18, 2025@23:21:08                                                                                                                                                                                                      Page 2

FHPRW3    ; HISC/REL - List Communication Offices ;4/25/93  14:23

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        FOR K1=0:0

               SET K1=$ORDER(^FH(119.73,K1))

               if K1'>0

                   QUIT

               DO Q4

 +3        QUIT

Q4         SET X=^FH(119.73,K1,0)

           DO BLD

           DO HDR

 +1        SET X1=$GET(^FH(119.73,K1,1))

           SET X2=$GET(^(2))

 +2        FOR LL=1:1:6

               SET Y=$PIECE(X2,"^",LL)

               IF Y'=""

                   DO MIP^FHSYSP

                   SET $PIECE(X2,"^",LL)=Y

 +3        WRITE !!,"Provide Bagged Meals:",?25

           SET Z=$PIECE(X2,"^",10)

           WRITE $SELECT(Z="Y":"YES",1:"NO")

 +4        WRITE !!?44,"Breakfast     Noon     Evening",!

 +5        WRITE !,?5,"Meal Time:"

           WRITE ?46,$JUSTIFY($PIECE(X2,"^",7),6),?57,$JUSTIFY($PIECE(X2,"^",8),6),?67,$JUSTIFY($PIECE(X2,"^",9),6)

 +6        WRITE !!,?5,"Early Time 1:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",1),6),?57,$JUSTIFY($PIECE(X1,"^",7),6),?67,$JUSTIFY($PIECE(X1,"^",13),6)

 +7        WRITE !,?5,"Early Time 2:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",2),6),?57,$JUSTIFY($PIECE(X1,"^",8),6),?67,$JUSTIFY($PIECE(X1,"^",14),6)

 +8        WRITE !,?5,"Early Time 3:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",3),6),?57,$JUSTIFY($PIECE(X1,"^",9),6),?67,$JUSTIFY($PIECE(X1,"^",15),6)

 +9        WRITE !!,?5,"Late Time 1:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",4),6),?57,$JUSTIFY($PIECE(X1,"^",10),6),?67,$JUSTIFY($PIECE(X1,"^",16),6)

 +10       WRITE !,?5,"Late Time 2:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",5),6),?57,$JUSTIFY($PIECE(X1,"^",11),6),?67,$JUSTIFY($PIECE(X1,"^",17),6)

 +11       WRITE !,?5,"Late Time 3:"

           WRITE ?46,$JUSTIFY($PIECE(X1,"^",6),6),?57,$JUSTIFY($PIECE(X1,"^",12),6),?67,$JUSTIFY($PIECE(X1,"^",18),6)

 +12       WRITE !!,?5,"Late Alarm Begin:"

           WRITE ?46,$JUSTIFY($PIECE(X2,"^",1),6),?57,$JUSTIFY($PIECE(X2,"^",3),6),?67,$JUSTIFY($PIECE(X2,"^",5),6)

 +13       WRITE !,?5,"Late Alarm End:"

           WRITE ?46,$JUSTIFY($PIECE(X2,"^",2),6),?57,$JUSTIFY($PIECE(X2,"^",4),6),?67,$JUSTIFY($PIECE(X2,"^",6),6)

 +14       DO WRD

           WRITE !

           QUIT

WRD        WRITE !!,"Associated Dietetic Wards:",!

 +1        KILL P

           SET N=0

           SET NM=""

FOR

               SET NM=$ORDER(^TMP($JOB,NM))

               if NM=""

                   QUIT

               SET N=N+1

               SET P(N)=$PIECE(NM,"~",1)

 +2        IF N

               SET (Z,K)=N+1\2

               FOR LL=1:1:Z

                   WRITE !?5,P(LL)

                   SET K=K+1

                   IF $DATA(P(K))

                       WRITE ?45,P(K)

 +3        QUIT

BLD       ; Build temp files

 +1        KILL ^TMP($JOB)

 +2        FOR LL=0:0

               SET LL=$ORDER(^FH(119.6,LL))

               if LL<1

                   QUIT

               SET Y=^(LL,0)

               IF $PIECE(Y,"^",8)=K1

                   DO B1

 +3        QUIT

B1         SET ^TMP($JOB,$PIECE(Y,"^",1)_"~"_LL)=""

           QUIT

HDR        if '($EXTRACT(IOST,1,2)'="C-"&'PG)

               WRITE @IOF

           SET PG=PG+1

           SET DTP=NOW

           DO DTP^FH

           WRITE !,$EXTRACT(DTP,1,9),?20,"C O M M U N I C A T I O N   O F F I C E",?73,"Page ",PG

 +1        SET Y=$PIECE(X,"^",1)

           WRITE !!?(78-$LENGTH(Y)\2),Y

 +2        WRITE !,"-------------------------------------------------------------------------------",!

           QUIT

FHPRW3.m