source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBNHRCS.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1FBNHRCS ;ACAMPUS/dmk-RCS 10-0168 (18-3)
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;this routine will output data needed to complete the CNH codesheet
5 ;it is a quarterly report. user will select first, second, third or
6 ;fourth quarter and fiscal year.
7 ;
8 D SITEP^FBAAUTL Q:$G(FBPOP)
9 W !!?17,"COMMUNITY NURSING HOME REPORT 10-0168",!!
10SELECT ;select quarter
11 S DIR(0)="SM^1:First Quarter;2:Second Quarter;3:Third Quarter;4:Fourth Quarter"
12 S DIR("?")="Select the reporting quarter"
13 D ^DIR K DIR Q:$D(DIRUT)
14 Q:'Y S FBQTR=+Y
15 ;
16 ;select fiscal year for report
17 S DIR(0)="D^::AE",DIR("A")="Fiscal Year: "
18 S DIR("?",1)="Examples of Valid Dates:"
19 S DIR("?",2)=" 1994 or 94 or 1/94 or an exact date"
20 S DIR("?")=" If you enter an exact date the Fiscal Year for that date will be used."
21 D ^DIR K DIR Q:$D(DIRUT)!('Y) S FBFY=+Y D
22 . ; set FBBEG = beginning date of selected quarter and fiscal year
23 . ; set FBEND = ending date of selected quarter and fiscal year
24 . ;
25 . S FBBEG=$E(FBFY,1,3)-$S(FBQTR=1:1,1:0)_$P($P($T(DATES+FBQTR),";;",2),"^")
26 . S FBEND=$E(FBFY,1,3)-$S(FBQTR=1:1,1:0)_$P($P($T(DATES+FBQTR),";;",2),"^",2)
27 ;
28CODE I $$VERSION^XPDUTL("GEC")>1.6 W !,"Do you want to generate code sheets for these Nursing Homes?" S DIR(0)="Y",DIR("B")="No" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT)) S:Y FBGECS=1
29 ;
30 W !!,"The CNH 10-0168 (RCS 18-3) will be compiled for the following date range:"
31 W !?5,"FROM DATE: ",$$DATX^FBAAUTL(FBBEG)," TO DATE: ",$$DATX^FBAAUTL(FBEND)
32 ;want to continue
33 S DIR(0)="Y",DIR("A")="Want to continue",DIR("B")="Yes" D ^DIR K DIR
34 G END:$D(DIRUT)!('Y)
35 ;
36 S PGM="START^FBNHRCS",VAR="FBBEG^FBEND^FBGECS^FBSITE(1)" D ZIS^FBAAUTL G:FBPOP END
37 ;
38START D START^FBNHRCS1,^FBNHRCS3 G END:$G(FBOUT) I $G(FBGECS) D ^FBNHRCS4
39 ;
40END K DTOUT,DIRUT,DUOUT,I,J,JJ,K,FB,FBD,FBHIGH,FBLOW,FBI,FBV,FBPOP,FBY,FBSITE,FBQTR,FBBEG,FBEND,FBFY,^TMP($J),VNAM,CNT,FBAASN,FBSN,FBGECS
41 D CLOSE^FBAAUTL Q
42 ;
43DATES ;store date ranges for each quarter (format mmdd $T(DATES)+FBQTR)
44 ;;1001^1231
45 ;;0101^0331
46 ;;0401^0630
47 ;;0701^0930
48 Q
Note: See TracBrowser for help on using the repository browser.