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 ---[H[J[2J[HDGYXCEN 1258 printed Nov 22, 2024@18:10:46 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
