- DG5398PT ;ALB/ABR - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF; 7/18/96
- ;;5.3;Registration;**98**;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 '96 CENSUS
- ;
- ;-- Census Date 9-30-96
- S CENDATE=2960930
- ;-- Close-out Date 11-01-96
- S CLOSDATE=2961101
- ;-- ok to x-mit PTF date 11-18-96
- S OKTOXM=2961118
- ;-- currently active
- S ACTIVE=1
- ;-- Census Period Start Date 10-1-9
- S CPSTART=2951001
- ;
- D BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for FY 1996.")
- ;
- 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
- ;
- 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 BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Call your IRMFO CS.")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5398PT 1237 printed Feb 19, 2025@00:05:32 Page 2
- DG5398PT ;ALB/ABR - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF; 7/18/96
- +1 ;;5.3;Registration;**98**;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 '96 CENSUS
- +5 ;
- +6 ;-- Census Date 9-30-96
- +7 SET CENDATE=2960930
- +8 ;-- Close-out Date 11-01-96
- +9 SET CLOSDATE=2961101
- +10 ;-- ok to x-mit PTF date 11-18-96
- +11 SET OKTOXM=2961118
- +12 ;-- currently active
- +13 SET ACTIVE=1
- +14 ;-- Census Period Start Date 10-1-9
- +15 SET CPSTART=2951001
- +16 ;
- +17 DO BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for FY 1996.")
- +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 DO MES^XPDUTL("Done.")
- +26 QUIT
- +27 ;
- +28 ; This will update the PTF CENSUS DATE File (#45.86). The EN tag may be re-run
- ERR ;
- +1 IF +ERR
- DO BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Call your IRMFO CS.")
- +2 QUIT