Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53141P

DG53141P.m

Go to the documentation of this file.
  1. DG53141P ;ALB/SEK 0% SC CLEANUP POST-INS DG*5.3*141 ;09/24/97
  1. ;;5.3;Registration;**141**;Aug 13, 1993
  1. ;
  1. ;This routine will be run as post-installation for patch DG*5.3*141.
  1. ;This is a cleanup for all 0% SC veterans who had an outpatient
  1. ;encounter since the installation of Tricare, who is an inpatient
  1. ;(when or since the installation of Tricare), who has a future
  1. ;appointment, and who has a Means Test entry since installation of
  1. ;Tricare. If the veteran meets any of the above criteria, routine
  1. ;DGMTR141 is called to determine if the veteran requires a Means Test.
  1. ;The following can occur:
  1. ; No change is made if the requirement is the same as the
  1. ; veteran has now.
  1. ; Status of the veteran will be changed to NO LONGER REQUIRED
  1. ; from REQUIRED.
  1. ; Status of the veteran will be changed to REQUIRED by
  1. ; adding a new test with a status of REQUIRED or by
  1. ; changing a NO LONGER REQUIRED status to REQUIRED.
  1. ;
  1. ; Status of Copay Tests will be changed to INCOMPLETE or
  1. ; NO LONGER APPLICABLE
  1. ;
  1. POST ;entry point for post-install, setting up checkpoints
  1. N %
  1. I $D(XPDNM) S %=$$NEWCP^XPDUTL("DFN","EN^DG53141P",0)
  1. Q
  1. ;
  1. EN ;begin processing
  1. ;
  1. ;go through PATIENT file finding 0% SC veterans and determine
  1. ;and change if necessary the Means Test status and/or add a
  1. ;REQUIRED Means Test
  1. N DFN,DGINSDT
  1. ;
  1. D BMES^XPDUTL(" >> 0% SC Means Test cleanup")
  1. ;
  1. ;get value from checkpoints, previous run
  1. I $D(XPDNM) S DFN=+$$PARCP^XPDUTL("DFN")
  1. ;
  1. D INSTDT
  1. D LOOP
  1. D PRINT
  1. Q
  1. ;
  1. ;
  1. INSTDT ;get install date of Tricare from KIDS file. If not found use
  1. ;Tricare release date (8/8/97)
  1. N I
  1. S I=0,I=$O(^XPD(9.7,"B","DG*5.3*114",I)) I 'I S DGINSDT=2970808 Q
  1. S DGINSDT=$P($P($G(^XPD(9.7,I,0)),"^",3),".") S:'DGINSDT DGINSDT=2970808
  1. Q
  1. ;
  1. LOOP ;
  1. N %
  1. S ^XTMP("DG53141G",0)=2980401_"^"_DT_"^"_"MEANS TEST REQUIRED CHANGED LOG" ;temp array
  1. I '$D(XPDNM) S DFN=0
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D I $D(XPDNM) S %=$$UPCP^XPDUTL("DFN",DFN)
  1. .I $P($G(^DPT(DFN,.3)),"^",2)'=0 Q
  1. .N DGADDDT,SORT
  1. .S DGADDDT=$$OUTPAT(DFN,DGINSDT) I DGADDDT S SORT=1 D EN^DG141PB Q
  1. .S DGADDDT=$$INPAT(DFN,DGINSDT) I DGADDDT S SORT=2 D EN^DG141PB Q
  1. .S DGADDDT=$$FUTAPP(DFN,DGINSDT) I DGADDDT S SORT=3 D EN^DG141PB Q
  1. .S DGADDDT=$$CURRMT(DFN,DGINSDT) I DGADDDT S SORT=4 D EN^DG141PB
  1. .Q
  1. Q
  1. ;
  1. ;
  1. OUTPAT(DFN,DGINSDT) ;check is veteran had an outpatient encounter since
  1. ;installation of Tricare
  1. ;input DFN Patient IEN
  1. ; DGINSDT Tricare installation date
  1. ;output 0 if no outpatient encounter
  1. ; date of encounter if had encounter
  1. ;
  1. N Y,INSDT
  1. S Y=0,INSDT=DGINSDT
  1. F S INSDT=$O(^SCE("ADFN",DFN,INSDT)) Q:('INSDT!(INSDT>(DT_.9999))) S Y=$P(INSDT,".") Q
  1. Q +$G(Y)
  1. ;
  1. INPAT(DFN,DGINSDT) ;check is veteran is an inpatient or was when Tricare
  1. ;was installed
  1. ;input DFN Patient IEN
  1. ; DGINSDT Tricare installation date
  1. ;output 0 if not an inpatient on or since date of Tricare installation
  1. ; date of installation if inpatient on installation
  1. ; date of becoming inpatient if after installation date
  1. ;
  1. ;
  1. N Y,I,J,INSDT
  1. S Y=0,INSDT=DGINSDT
  1. I '$D(^DGPM("ADFN"_DFN)) G INPATQ
  1. F S INSDT=$O(^DGPM("ADFN"_DFN,INSDT)) Q:'INSDT D Q:Y'=0
  1. .S I=0 F S I=$O(^DGPM("ADFN"_DFN,INSDT,I)) Q:'I D Q:Y'=0
  1. ..S J=$P($G(^DGPM(I,0)),"^",2)
  1. ..I J=1 S Y=$P(INSDT,".") Q
  1. ..I "^2^3^6^"[("^"_J_"^") S Y=DGINSDT Q
  1. ..I $D(^DPT(DFN,.105)) S Y=DGINSDT
  1. ..Q
  1. INPATQ Q +$G(Y)
  1. ;
  1. ;
  1. FUTAPP(DFN,DGINSDT) ;check is veteran has a future appointment
  1. ;input DFN Patient IEN
  1. ; DGINSDT Tricare installation date
  1. ;output 0 if no future appointment
  1. ; today's date if has future appointment
  1. ;
  1. ;
  1. N Y,INSDT
  1. S Y=0,INSDT=DGINSDT
  1. F S INSDT=$O(^DPT(DFN,"S",INSDT)) Q:'INSDT I $P($G(^DPT(DFN,"S",INSDT,0)),"^",2)="" S Y=DT Q
  1. Q +$G(Y)
  1. ;
  1. ;
  1. CURRMT(DFN,DGINSDT) ;check if veteran had a Means Test since installation
  1. ; of Tricare
  1. ;input DFN Patient IEN
  1. ; DGINSDT Tricare installation date
  1. ;output 0 if had no Means Test
  1. ; date of Means Test
  1. ;
  1. ;
  1. N Y,INSDT,DGMTCU
  1. S Y=0,INSDT=DGINSDT
  1. S DGMTCU=$P($$LST^DGMTU(DFN),"^",2) S:DGMTCU>(INSDT-1) Y=DGMTCU
  1. Q +$G(Y)
  1. ;
  1. ;
  1. PRINT ;print summary
  1. N TOTAL,I
  1. S TOTAL=0 F I=1:1:4 S TOTAL=$G(^XTMP("DG53141G",1,I,0))+TOTAL
  1. D BMES^XPDUTL(TOTAL_" 0% SC vets made Means Test REQUIRED")
  1. S TOTAL=0 F I=1:1:4 S TOTAL=$G(^XTMP("DG53141G",3,I,0))+TOTAL
  1. D BMES^XPDUTL(TOTAL_" 0% SC vets made Means Test NO LONGER REQUIRED")
  1. D BMES^XPDUTL(" >> cleanup done.")
  1. D BMES^XPDUTL(" >> run DG141 LIST [DG141 SC 0% MT REPORT] option to produce report(s)")
  1. Q