source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHCMSR.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1FHCMSR ; HISC/NCA - Cost of Meals Served ;3/20/95 09:22
2 ;;5.5;DIETETICS;;Jan 28, 2005
3EN1 ; 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
17EN2 ; Print the Cost of Meals Served
18 D NOW^%DTC S DT=%\1
19D1 ; 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"
27D2 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
38KIL G KILL^XUSCLEAN
39HELP ; 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
Note: See TracBrowser for help on using the repository browser.