- 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 Feb 19, 2025@00:02:18 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