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