source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYXCEN.m@ 700

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1DGYXCEN ;ALB/LM - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF ; 8/10/95
2 ;;5.3;Registration;**66**;Aug 13, 1993
3 ;
4 ;
5CENSUS ;--- add new census date
6 ; These dates should be update each year per MAS VACO.
7EN ;
8 N CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR
9 S ERR=0
10 ;
11 ;-- ALL DATES ARE FOR '95 CENSUS
12 ;
13 ;-- Census Date 9-30-95
14 S CENDATE=2950930
15 ;-- Close-out Date 10-31-95
16 S CLOSDATE=2951031
17 ;-- ok to x-mit PTF date 11-1-95
18 S OKTOXM=2951101
19 ;-- currently active
20 S ACTIVE=1
21 ;-- Census Period Start Date 10-1-94
22 S CPSTART=2941001
23 ;
24 W !!,">>> Updating PTF Census Date File (#45.86) for FY 1995."
25 ;
26 S X=$O(^DG(45.86,"AC",0)) I X S X=$O(^DG(45.86,"AC",X,0)),DIE="^DG(45.86,",DA=X,DR=".04////0" D ^DIE K DIE,DR,DA
27 S DIC="^DG(45.86,",X=CENDATE,DIC(0)="L" K DD,DO D ^DIC K DIC
28 I Y'>0 S ERR=1 D ERR Q ;checks to see if record is created
29 S DIE="^DG(45.86,",DA=+Y,DR=".02////"_CLOSDATE_";.03////"_OKTOXM_";.04////"_ACTIVE_";.05////"_CPSTART
30 D ^DIE K DIE,DR,DA
31 ;
32 W "Done."
33 Q
34 ;
35 ; This will update the PTF CENSUS DATE File (#45.86). The EN tag may be re-run
36ERR N DGPRINT
37 S DGPRINT=$S($D(ZTQUEUED):0,1:1)
38 I +ERR W:$G(DGPRINT) !,"Problem with PTF CENSUS DATE File (#45.86) Update. Call your IRMFO CS."
39 Q
Note: See TracBrowser for help on using the repository browser.