| 1 | FHCMSR ; HISC/NCA - Cost of Meals Served ;3/20/95 09:22
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | EN1 ; Read in Month/Year
|
|---|
| 4 | R !!,"Enter Month/Year of Cost of Meals Served: ",X:DTIME G:'$T!("^"[X) KIL I X["?" D HELP G EN1
|
|---|
| 5 | K %DT S Z=0,%DT="EP"
|
|---|
| 6 | D ^%DT G KIL:"^"[X!($D(DTOUT)),EN1:Y<1
|
|---|
| 7 | I '$E(Y,4,5) W *7,!,"You Must enter a Month and a Year." G EN1
|
|---|
| 8 | S DA=$E(+Y,1,5)_"00"
|
|---|
| 9 | I DA>DT W *7,!?5,"Month/Year must not be in the future." G EN1
|
|---|
| 10 | K DIC,DIE W ! S DIE="^FH(117.2,"
|
|---|
| 11 | L +^FH(117.2,DA,0):0 I '$T W !?5,"Another user is editing this entry." G KIL
|
|---|
| 12 | I '$D(^FH(117.2,DA,0)) S $P(^FH(117.2,DA,0),"^",1)=DA,^FH(117.2,"B",DA,DA)="",Z=$P(^FH(117.2,0),"^",4)+1,$P(^FH(117.2,0),"^",3,4)=DA_"^"_Z
|
|---|
| 13 | S FHX1=""
|
|---|
| 14 | S S1=$E(DA,4,5),S2=$S(S1<4:"01",S1<7:"04",S1<10:"07",1:10) G:'S2 EN1 S S1=$E(DA,1,3)_S2_"00"
|
|---|
| 15 | S X1=S1,X2=-1 D C^%DTC S FHPRE=X,FHPRE=$E(FHPRE,1,5)_"00",FHX1=$P($G(^FH(117.2,FHPRE,0)),"^",14,19)
|
|---|
| 16 | S DR="[FHCMSR]" D ^DIE L -^FH(117.2,DA,0) K DIC,DIE,DA,DR,DTOUT G EN1
|
|---|
| 17 | EN2 ; Print the Cost of Meals Served
|
|---|
| 18 | D NOW^%DTC S DT=%\1
|
|---|
| 19 | D1 ; Get Start-End Month/Year
|
|---|
| 20 | R !!,"Starting Month/Year: ",X:DTIME G:'$T!("^"[X) KIL
|
|---|
| 21 | I X["?" D HELP G D1
|
|---|
| 22 | K %DT S %DT="EP"
|
|---|
| 23 | D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D1:Y<1 S SDT=+Y
|
|---|
| 24 | I $E(SDT,1,5)'<$E(DT,1,5) W *7,!," Month/Year Must Start before Current Month/Year! " G D1
|
|---|
| 25 | I '$E(SDT,4,5) W *7,!," You Must enter a Month and a Year." G D1
|
|---|
| 26 | S SDT=$E(SDT,1,5)_"00"
|
|---|
| 27 | D2 R !,"Ending Month/Year: ",X:DTIME G:'$T!("^"[X) KIL
|
|---|
| 28 | I X["?" D HELP G D2
|
|---|
| 29 | S %DT="EP"
|
|---|
| 30 | D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D2:Y<1 S EDT=+Y
|
|---|
| 31 | I '$E(EDT,4,5) W *7,!," You Must enter a Month and a Year." G D1
|
|---|
| 32 | I $E(EDT,1,5)'<$E(DT,1,5) W *7,!," Month/Year Must be before Current Month/Year. " G D1
|
|---|
| 33 | I $E(EDT,1,5)<$E(SDT,1,5) W *7,!," End Cannot be before Start Month/Year." G D1
|
|---|
| 34 | S EDT=$E(EDT,1,5)_"00"
|
|---|
| 35 | K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
|
|---|
| 36 | I $D(IO("Q")) S FHPGM="Q1^FHCMSR1",FHLST="EDT^SDT" D EN2^FH G KIL
|
|---|
| 37 | U IO D Q1^FHCMSR1 D ^%ZISC K %ZIS,IOP G KIL
|
|---|
| 38 | KIL G KILL^XUSCLEAN
|
|---|
| 39 | HELP ; Help Message
|
|---|
| 40 | W !!,"Enter a Month and a Year such as 6 2000, 6/2000, 6-2000, or June 2000.",!
|
|---|
| 41 | W "You can even enter T-1 or type in a date.",!
|
|---|
| 42 | Q
|
|---|
