FHCMSR ; HISC/NCA - Cost of Meals Served ;3/20/95 09:22
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Read in Month/Year
R !!,"Enter Month/Year of Cost of Meals Served: ",X:DTIME G:'$T!("^"[X) KIL I X["?" D HELP G EN1
K %DT S Z=0,%DT="EP"
D ^%DT G KIL:"^"[X!($D(DTOUT)),EN1:Y<1
I '$E(Y,4,5) W *7,!,"You Must enter a Month and a Year." G EN1
S DA=$E(+Y,1,5)_"00"
I DA>DT W *7,!?5,"Month/Year must not be in the future." G EN1
K DIC,DIE W ! S DIE="^FH(117.2,"
L +^FH(117.2,DA,0):0 I '$T W !?5,"Another user is editing this entry." G KIL
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
S FHX1=""
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"
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)
S DR="[FHCMSR]" D ^DIE L -^FH(117.2,DA,0) K DIC,DIE,DA,DR,DTOUT G EN1
EN2 ; Print the Cost of Meals Served
D NOW^%DTC S DT=%\1
D1 ; Get Start-End Month/Year
R !!,"Starting Month/Year: ",X:DTIME G:'$T!("^"[X) KIL
I X["?" D HELP G D1
K %DT S %DT="EP"
D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D1:Y<1 S SDT=+Y
I $E(SDT,1,5)'<$E(DT,1,5) W *7,!," Month/Year Must Start before Current Month/Year! " G D1
I '$E(SDT,4,5) W *7,!," You Must enter a Month and a Year." G D1
S SDT=$E(SDT,1,5)_"00"
D2 R !,"Ending Month/Year: ",X:DTIME G:'$T!("^"[X) KIL
I X["?" D HELP G D2
S %DT="EP"
D ^%DT S:$D(DTOUT) X="^" G KIL:U[X,D2:Y<1 S EDT=+Y
I '$E(EDT,4,5) W *7,!," You Must enter a Month and a Year." G D1
I $E(EDT,1,5)'<$E(DT,1,5) W *7,!," Month/Year Must be before Current Month/Year. " G D1
I $E(EDT,1,5)<$E(SDT,1,5) W *7,!," End Cannot be before Start Month/Year." G D1
S EDT=$E(EDT,1,5)_"00"
K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHCMSR1",FHLST="EDT^SDT" D EN2^FH G KIL
U IO D Q1^FHCMSR1 D ^%ZISC K %ZIS,IOP G KIL
KIL G KILL^XUSCLEAN
HELP ; Help Message
W !!,"Enter a Month and a Year such as 6 2000, 6/2000, 6-2000, or June 2000.",!
W "You can even enter T-1 or type in a date.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHCMSR 2189 printed Apr 09, 2024@20:57:10 Page 2
FHCMSR ; HISC/NCA - Cost of Meals Served ;3/20/95 09:22
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Read in Month/Year
+1 READ !!,"Enter Month/Year of Cost of Meals Served: ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
IF X["?"
DO HELP
GOTO EN1
+2 KILL %DT
SET Z=0
SET %DT="EP"
+3 DO ^%DT
if "^"[X!($DATA(DTOUT))
GOTO KIL
if Y<1
GOTO EN1
+4 IF '$EXTRACT(Y,4,5)
WRITE *7,!,"You Must enter a Month and a Year."
GOTO EN1
+5 SET DA=$EXTRACT(+Y,1,5)_"00"
+6 IF DA>DT
WRITE *7,!?5,"Month/Year must not be in the future."
GOTO EN1
+7 KILL DIC,DIE
WRITE !
SET DIE="^FH(117.2,"
+8 LOCK +^FH(117.2,DA,0):0
IF '$TEST
WRITE !?5,"Another user is editing this entry."
GOTO KIL
+9 IF '$DATA(^FH(117.2,DA,0))
SET $PIECE(^FH(117.2,DA,0),"^",1)=DA
SET ^FH(117.2,"B",DA,DA)=""
SET Z=$PIECE(^FH(117.2,0),"^",4)+1
SET $PIECE(^FH(117.2,0),"^",3,4)=DA_"^"_Z
+10 SET FHX1=""
+11 SET S1=$EXTRACT(DA,4,5)
SET S2=$SELECT(S1<4:"01",S1<7:"04",S1<10:"07",1:10)
if 'S2
GOTO EN1
SET S1=$EXTRACT(DA,1,3)_S2_"00"
+12 SET X1=S1
SET X2=-1
DO C^%DTC
SET FHPRE=X
SET FHPRE=$EXTRACT(FHPRE,1,5)_"00"
SET FHX1=$PIECE($GET(^FH(117.2,FHPRE,0)),"^",14,19)
+13 SET DR="[FHCMSR]"
DO ^DIE
LOCK -^FH(117.2,DA,0)
KILL DIC,DIE,DA,DR,DTOUT
GOTO EN1
EN2 ; Print the Cost of Meals Served
+1 DO NOW^%DTC
SET DT=%\1
D1 ; Get Start-End Month/Year
+1 READ !!,"Starting Month/Year: ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
+2 IF X["?"
DO HELP
GOTO D1
+3 KILL %DT
SET %DT="EP"
+4 DO ^%DT
if $DATA(DTOUT)
SET X="^"
if U[X
GOTO KIL
if Y<1
GOTO D1
SET SDT=+Y
+5 IF $EXTRACT(SDT,1,5)'<$EXTRACT(DT,1,5)
WRITE *7,!," Month/Year Must Start before Current Month/Year! "
GOTO D1
+6 IF '$EXTRACT(SDT,4,5)
WRITE *7,!," You Must enter a Month and a Year."
GOTO D1
+7 SET SDT=$EXTRACT(SDT,1,5)_"00"
D2 READ !,"Ending Month/Year: ",X:DTIME
if '$TEST!("^"[X)
GOTO KIL
+1 IF X["?"
DO HELP
GOTO D2
+2 SET %DT="EP"
+3 DO ^%DT
if $DATA(DTOUT)
SET X="^"
if U[X
GOTO KIL
if Y<1
GOTO D2
SET EDT=+Y
+4 IF '$EXTRACT(EDT,4,5)
WRITE *7,!," You Must enter a Month and a Year."
GOTO D1
+5 IF $EXTRACT(EDT,1,5)'<$EXTRACT(DT,1,5)
WRITE *7,!," Month/Year Must be before Current Month/Year. "
GOTO D1
+6 IF $EXTRACT(EDT,1,5)<$EXTRACT(SDT,1,5)
WRITE *7,!," End Cannot be before Start Month/Year."
GOTO D1
+7 SET EDT=$EXTRACT(EDT,1,5)_"00"
+8 KILL IOP,%ZIS
SET %ZIS("A")="Print on Device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+9 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHCMSR1"
SET FHLST="EDT^SDT"
DO EN2^FH
GOTO KIL
+10 USE IO
DO Q1^FHCMSR1
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
KIL GOTO KILL^XUSCLEAN
HELP ; Help Message
+1 WRITE !!,"Enter a Month and a Year such as 6 2000, 6/2000, 6-2000, or June 2000.",!
+2 WRITE "You can even enter T-1 or type in a date.",!
+3 QUIT
