| 1 | DGYXCEN ;ALB/LM - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF ; 8/10/95
|
|---|
| 2 | ;;5.3;Registration;**66**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | CENSUS ;--- add new census date
|
|---|
| 6 | ; These dates should be update each year per MAS VACO.
|
|---|
| 7 | EN ;
|
|---|
| 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
|
|---|
| 36 | ERR 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
|
|---|
