- 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
- 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
