| [613] | 1 | FHSPTAB ; HISC/REL/NCA - Tabulate Standing Orders ;4/27/93 13:07
|
|---|
| 2 | ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
|
|---|
| 3 | ;11/10/05 modified to add outpatient standing order.
|
|---|
| 4 | S FHOPT=3 ;tabulate standing order flag.
|
|---|
| 5 | S FHP=$O(^FH(119.72,0)) I FHP'<1,$O(^FH(119.72,FHP))<1 S FHP=0 G R1
|
|---|
| 6 | R0 R !!,"Select SERVICE POINT (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S FHP=0
|
|---|
| 7 | E K DIC S DIC="^FH(119.72,",DIC(0)="EMQ" D ^DIC G:Y<1 R0 S FHP=+Y
|
|---|
| 8 | R1 R !!,"Select Meal (B,N,E or ALL): ",MEAL:DTIME G:'$T!("^"[MEAL) KIL S X=MEAL D TR^FH S MEAL=X S:$P("ALL",MEAL,1)="" MEAL="A"
|
|---|
| 9 | I "BNEA"'[MEAL!(MEAL'?1U) W *7,!,"Enter B for Breakfast, N for Noon , E for Evening or ALL for all meals" G R1
|
|---|
| 10 | R3 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 11 | I $D(IO("Q")) S FHPGM="Q1^FHSPTAB",FHLST="FHP^MEAL^FHOPT" D EN2^FH G KIL
|
|---|
| 12 | U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL
|
|---|
| 13 | Q1 ; Print the Tabulated List of Standing Orders
|
|---|
| 14 | D NOW^%DTC S NOW=%,PG=0 I MEAL'="A" G Q2
|
|---|
| 15 | F MEAL="B","N","E" D Q2
|
|---|
| 16 | Q
|
|---|
| 17 | Q2 S T0=(NOW\1)_$S(MEAL="B":".07",MEAL="N":".11",1:".17")
|
|---|
| 18 | K N F W1=0:0 S W1=$O(^FH(119.6,W1)) Q:W1<1 D DP I DP'="" F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",W1,FHDFN)) Q:FHDFN<1 S ADM=^FHPT("AW",W1,FHDFN) D ADD
|
|---|
| 19 | ;get outpatient so.
|
|---|
| 20 | D ADDO^FHSP1
|
|---|
| 21 | D HDR S NX="" F K1=0:0 S NX=$O(^FH(118.3,"B",NX)) Q:NX="" F K=0:0 S K=$O(^FH(118.3,"B",NX,K)) Q:K<1 I $D(N(K)) D:$Y>56 HDR W !,$J(N(K),6)," ",$P(^FH(118.3,K,0),"^",1)
|
|---|
| 22 | W ! Q
|
|---|
| 23 | ADD Q:ADM<1 D CHK I K2 F K2=0:0 S K2=$O(^FHPT("ASP",FHDFN,ADM,K2)) Q:K2<1 S X=^FHPT(FHDFN,"A",ADM,"SP",K2,0) D A1
|
|---|
| 24 | Q
|
|---|
| 25 | A1 S FHORD=$P(X,"^",2),M1=$P(X,"^",3) I FHORD,M1[MEAL S:'$D(N(FHORD)) N(FHORD)=0 S Q=$P(X,"^",8),N(FHORD)=N(FHORD)+$S(Q:Q,1:1)
|
|---|
| 26 | Q
|
|---|
| 27 | CHK S K2=0,X1=$G(^FHPT(FHDFN,"A",ADM,0)),FHORD=$P(X1,"^",2),X1=$P(X1,"^",3) G:FHORD<1 C1
|
|---|
| 28 | I X1>1,X1'>T0 G C2
|
|---|
| 29 | C0 I '$D(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)) G C2
|
|---|
| 30 | S X1=$P(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),"^",8) I X1="" G C1
|
|---|
| 31 | S:X1="D" X1="T" S:DP[X1 K2=1
|
|---|
| 32 | C1 K FHORD,A1,K,X1 Q
|
|---|
| 33 | C2 S A1=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"AC",K)) Q:K<1!(K>T0) S A1=K
|
|---|
| 34 | G:'A1 C1 S FHORD=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2) G:FHORD'<1 C0 K ^FHPT(FHDFN,"A",ADM,"AC",A1) G C2
|
|---|
| 35 | DP S DP="" I 'FHP S DP="TC" Q
|
|---|
| 36 | S X=$P($G(^FH(119.6,W1,0)),"^",5,6) S:$P(X,"^",1)=FHP DP="T" S:$P(X,"^",2)=FHP DP=DP_"C" Q
|
|---|
| 37 | HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,DTP,?25,"S T A N D I N G O R D E R S",?74,"Page ",PG
|
|---|
| 38 | W !! W:FHP $P(^FH(119.72,FHP,0),"^",1) S Y=$S(MEAL="B":"BREAKFAST",MEAL="N":"NOON",1:"EVENING") W ?(80-$L(Y)\2),Y
|
|---|
| 39 | W !!,"Quantity Order",! Q
|
|---|
| 40 | KIL G KILL^XUSCLEAN
|
|---|
