DGYKCEN ;ALB/ABR - Census Post-Init Driver for 10/1 Maintenance Patch ; 6/14/94
;;5.3;Registration;**31**;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 '94 CENSUS
;
;-- Census Date 9-30-94
S CENDATE=2940930
;-- Close-out Date 10-31-94
S CLOSDATE=2941031
;-- ok to x-mit PTF date 11-1-94
S OKTOXM=2941101
;-- currently active
S ACTIVE=1
;-- Census Period Start Date 10-1-93
S CPSTART=2931001
;
W !!,">>> Updating Census Dates..."
;
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 ISC Support."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYKCEN 1248 printed Oct 16, 2024@19:00:42 Page 2
DGYKCEN ;ALB/ABR - Census Post-Init Driver for 10/1 Maintenance Patch ; 6/14/94
+1 ;;5.3;Registration;**31**;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 '94 CENSUS
+5 ;
+6 ;-- Census Date 9-30-94
+7 SET CENDATE=2940930
+8 ;-- Close-out Date 10-31-94
+9 SET CLOSDATE=2941031
+10 ;-- ok to x-mit PTF date 11-1-94
+11 SET OKTOXM=2941101
+12 ;-- currently active
+13 SET ACTIVE=1
+14 ;-- Census Period Start Date 10-1-93
+15 SET CPSTART=2931001
+16 ;
+17 WRITE !!,">>> Updating Census Dates..."
+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 ISC Support."
+3 QUIT
