DGYXCEN.m

DGYXCEN ;ALB/LM - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF ; 8/10/95

 ;;5.3;Registration;**66**;Aug 13, 1993

 ;

 ;

CENSUS ;--- add new census date

 ;    These dates should be update each year per MAS VACO.

EN ;

 N CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR

 S ERR=0

 ;

 ;-- ALL DATES ARE FOR '95 CENSUS

 ;

 ;-- Census Date 9-30-95

 S CENDATE=2950930

 ;-- Close-out Date 10-31-95

 S CLOSDATE=2951031

 ;-- ok to x-mit PTF date 11-1-95

 S OKTOXM=2951101

 ;-- currently active

 S ACTIVE=1

 ;-- Census Period Start Date 10-1-94

 S CPSTART=2941001

 ;

 W !!,">>> Updating PTF Census Date File (#45.86) for FY 1995."

 ;

 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

 S DIC="^DG(45.86,",X=CENDATE,DIC(0)="L" K DD,DO D ^DIC K DIC

 I Y'>0 S ERR=1 D ERR Q  ;checks to see if record is created

 S DIE="^DG(45.86,",DA=+Y,DR=".02////"_CLOSDATE_";.03////"_OKTOXM_";.04////"_ACTIVE_";.05////"_CPSTART

 D ^DIE K DIE,DR,DA

 ;

 W "Done."

 Q

 ;

 ; This will update the PTF CENSUS DATE File (#45.86).  The EN tag may be re-run

ERR N DGPRINT

 S DGPRINT=$S($D(ZTQUEUED):0,1:1)

 I +ERR W:$G(DGPRINT) !,"Problem with PTF CENSUS DATE File (#45.86) Update.  Call your IRMFO CS."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGYXCEN   1258     printed  Apr 09, 2024@21:43:58                                                                                                                                                                                                     Page 2

DGYXCEN   ;ALB/LM - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF ; 8/10/95

 +1       ;;5.3;Registration;**66**;Aug 13, 1993

 +2       ;

 +3       ;

CENSUS    ;--- add new census date

 +1       ;    These dates should be update each year per MAS VACO.

EN        ;

 +1        NEW CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR

 +2        SET ERR=0

 +3       ;

 +4       ;-- ALL DATES ARE FOR '95 CENSUS

 +5       ;

 +6       ;-- Census Date 9-30-95

 +7        SET CENDATE=2950930

 +8       ;-- Close-out Date 10-31-95

 +9        SET CLOSDATE=2951031

 +10      ;-- ok to x-mit PTF date 11-1-95

 +11       SET OKTOXM=2951101

 +12      ;-- currently active

 +13       SET ACTIVE=1

 +14      ;-- Census Period Start Date 10-1-94

 +15       SET CPSTART=2941001

 +16      ;

 +17       WRITE !!,">>> Updating PTF Census Date File (#45.86) for FY 1995."

 +18      ;

 +19       SET X=$ORDER(^DG(45.86,"AC",0))

           IF X

               SET X=$ORDER(^DG(45.86,"AC",X,0))

               SET DIE="^DG(45.86,"

               SET DA=X

               SET DR=".04////0"

               DO ^DIE

               KILL DIE,DR,DA

 +20       SET DIC="^DG(45.86,"

           SET X=CENDATE

           SET DIC(0)="L"

           KILL DD,DO

           DO ^DIC

           KILL DIC

 +21      ;checks to see if record is created

           IF Y'>0

               SET ERR=1

               DO ERR

               QUIT 

 +22       SET DIE="^DG(45.86,"

           SET DA=+Y

           SET DR=".02////"_CLOSDATE_";.03////"_OKTOXM_";.04////"_ACTIVE_";.05////"_CPSTART

 +23       DO ^DIE

           KILL DIE,DR,DA

 +24      ;

 +25       WRITE "Done."

 +26       QUIT 

 +27      ;

 +28      ; This will update the PTF CENSUS DATE File (#45.86).  The EN tag may be re-run

ERR        NEW DGPRINT

 +1        SET DGPRINT=$SELECT($DATA(ZTQUEUED):0,1:1)

 +2        IF +ERR

               if $GET(DGPRINT)

                   WRITE !,"Problem with PTF CENSUS DATE File (#45.86) Update.  Call your IRMFO CS."

 +3        QUIT