DG53188P ;ALB/MM - QUARTERLY PATIENT CENSUS CLOSEOUT OF PTF; 8/8/1998
;;5.3;Registration;**188**;Aug 13, 1993
;
;
CENSUS ;--- add new census date
; These dates should be updated each quarter, per MAS VACO.
;
; **NOTE - the input transform for the .01 field of file 45.86
; needs to be updated quarterly to the last date of the quarter
; for this routine to run successfully.
;
; Patch will include routine to update dates, and Data Dictionary
; for .01 field
;
EN ;
N CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR
N DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
;
S ERR=0
;
;-- ALL DATES ARE FOR FY1998, Q4 CENSUS
;
;-- Census Date 09-30-1998
S CENDATE=2980930
;-- Close-out Date 10-16-1998
S CLOSDATE=2981016
;
;-- ok to x-mit PTF date 3-31-1997
; **no need to change, per Austin
S OKTOXM=2970331
;-- currently active
S ACTIVE=1
;-- Census Period Start Date 07-1-1998
S CPSTART=2980701
;
D BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for 4th Quarter, FY 1998.")
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",DLAYGO=45.86 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
;
D MES^XPDUTL("Done.")
Q
;
; This will update the PTF CENSUS DATE File (#45.86). The EN tag may be re-run
ERR ;
I +ERR D
.D BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Please")
.D MES^XPDUTL("contact the PIMS National VISTA Support Team for assistance.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53188P 1729 printed Dec 13, 2024@02:36:32 Page 2
DG53188P ;ALB/MM - QUARTERLY PATIENT CENSUS CLOSEOUT OF PTF; 8/8/1998
+1 ;;5.3;Registration;**188**;Aug 13, 1993
+2 ;
+3 ;
CENSUS ;--- add new census date
+1 ; These dates should be updated each quarter, per MAS VACO.
+2 ;
+3 ; **NOTE - the input transform for the .01 field of file 45.86
+4 ; needs to be updated quarterly to the last date of the quarter
+5 ; for this routine to run successfully.
+6 ;
+7 ; Patch will include routine to update dates, and Data Dictionary
+8 ; for .01 field
+9 ;
EN ;
+1 NEW CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR
+2 NEW DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
+3 ;
+4 SET ERR=0
+5 ;
+6 ;-- ALL DATES ARE FOR FY1998, Q4 CENSUS
+7 ;
+8 ;-- Census Date 09-30-1998
+9 SET CENDATE=2980930
+10 ;-- Close-out Date 10-16-1998
+11 SET CLOSDATE=2981016
+12 ;
+13 ;-- ok to x-mit PTF date 3-31-1997
+14 ; **no need to change, per Austin
+15 SET OKTOXM=2970331
+16 ;-- currently active
+17 SET ACTIVE=1
+18 ;-- Census Period Start Date 07-1-1998
+19 SET CPSTART=2980701
+20 ;
+21 DO BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for 4th Quarter, FY 1998.")
+22 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
+23 SET DIC="^DG(45.86,"
SET X=CENDATE
SET DIC(0)="L"
SET DLAYGO=45.86
KILL DD,DO
DO ^DIC
KILL DIC
+24 ;checks to see if record is created
IF Y'>0
SET ERR=1
DO ERR
QUIT
+25 SET DIE="^DG(45.86,"
SET DA=+Y
SET DR=".02////"_CLOSDATE_";.03////"_OKTOXM_";.04////"_ACTIVE_";.05////"_CPSTART
+26 DO ^DIE
KILL DIE,DR,DA
+27 ;
+28 DO MES^XPDUTL("Done.")
+29 QUIT
+30 ;
+31 ; This will update the PTF CENSUS DATE File (#45.86). The EN tag may be re-run
ERR ;
+1 IF +ERR
Begin DoDot:1
+2 DO BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Please")
+3 DO MES^XPDUTL("contact the PIMS National VISTA Support Team for assistance.")
End DoDot:1
+4 QUIT
