DG53130P ;ALB/SEK INCORRECT COPAY STATUS CLEANUP POST-INS ; 06/24/97
;;5.3;Registration;**130**;Aug 13, 1993
;
;This routine will be run as post-installation for patch DG*5.3*130.
;This routine will change the STATUS field (#.03) to 8 (non-exempt)
;from 9 (incomplete) in the ANNUAL MEANS TEST file (#408.13) for
;copay tests when the veteran declines to give income information.
;
POST ;entry point for post-install, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DGTTDT","EN^DG53130P",-9999999)
Q
;
EN ;begin processing
;
;update PACKAGE file for installation of IVM patch IVM*2*8
D UPDATE
;
;go through ANNUAL MEANS TEST file changing STATUS to 8 from 9
;for copay tests when veteran declines to give income information.
N DGTTDT
;
D BMES^XPDUTL(" >> Copay incomplete status cleanup")
;
;get value from checkpoints, previous run
S DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
;
D LOOP
D MAIL
Q
;
;
UPDATE ; update PACKAGE file for install of IVM patch IVM*2*8
N PKG,VER,PATCH
; find ien of IVM in PACKAGE file
S PKG=$O(^DIC(9.4,"B","INCOME VERIFICATION MATCH",0)) Q:'PKG
S VER="2.0" ; version
S PATCH="8^"_DT_"^"_DUZ ; patch #^today^installed by
;
D BMES^XPDUTL(" >>Updating Patch Application History for IVM with IVM*2*8")
S PATCH=$$PKGPAT^XPDIP(PKG,VER,.PATCH)
Q
;
;
LOOP ;
N DFN,DGFL,DGFLD,DGIEN,DGINY,DGMTA,DGVAL,%
S ^XTMP("DG53130P",0)=$$FMADD^XLFDT(DT+30)_"^"_DT_"^"_"COPAY STATUS CHANGED LOG" ;temp array
F S DGTTDT=$O(^DGMT(408.31,"AS",2,9,DGTTDT)) Q:'DGTTDT D
.S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",2,9,DGTTDT,DFN)) Q:'DFN D
..S DGIEN=0 F S DGIEN=$O(^DGMT(408.31,"AS",2,9,DGTTDT,DFN,DGIEN)) Q:'DGIEN D
...S DGMTA=$G(^DGMT(408.31,DGIEN,0)) Q:'DGMTA
...Q:'$P(DGMTA,"^",14)
...S DGFL=408.31,DGFLD=.03,DGVAL=9 D KILL^DGMTR
...S DGVAL=8,$P(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL D SET^DGMTR
...;
...;get income year
...S Y=$E(DGTTDT,2,4) S Y=Y-1 X ^DD("DD") S DGINY=Y
...;
...; - build list of copay tests changed
...D BUILDLN
...;
.;update checkpoint
.S %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
Q
;
;
;
BUILDLN ; Build storage array with data
;
; Output:
; ^XTMP("DG53130P",pt name,pt ssn,income year)=""
;
N DGNAME,DGSSN
;
; - pt name and ssn from Patient (#2) file
S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^(.36)),"^",3)
S:DGNAME="" DGNAME=DFN
S:DGSSN="" DGSSN="MISSING"
;
S ^XTMP("DG53130P",DGNAME,DGSSN,DGINY)=""
Q
;
;
MAIL ; Send a mailman msg to user listing copay tests with status change
N DIFROM,%
N DGCTR,DGCTXT,DGCX,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
D BMES^XPDUTL(" >> cleanup done.")
D BMES^XPDUTL(" >> Sending mailman msg listing copay tests with status change.")
S XMSUB="LIST OF COPAY TESTS WITH STATUS CHANGE"
S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="DGCTXT("
S DGCX=$$SITE^VASITE
D NOW^%DTC S Y=% D DD^%DT
S DGCTXT(1)="LIST OF COPAY TESTS WITH STATUS CHANGE FROM INCOMPLETE TO NON-EXEMPT"
S DGCTXT(2)=" WHEN THE PATIENT DECLINES TO GIVE INCOME INFORMATION"
S DGCTXT(3)=" "
I $O(^XTMP("DG53130P",0))']"" D G MAIL1
.S DGCTXT(4)="No copay tests changed."
.S DGCTXT(5)=" "
S DGCTXT(4)="Patient Name Patient SSN Income Year"
S DGCTXT(5)="============================================================"
;
; - create list of patients
N DGBLANK,DGLINE,DGNM,DGNUM
S DGBLANK="",$P(DGBLANK," ",30)="",DGCTR=8
S DGNM="" F S DGNM=$O(^XTMP("DG53130P",DGNM)) Q:DGNM']"" D
.S DGNUM="" F S DGNUM=$O(^XTMP("DG53130P",DGNM,DGNUM)) Q:DGNUM']"" D
..S DGLINE="" F S DGLINE=$O(^XTMP("DG53130P",DGNM,DGNUM,DGLINE)) Q:DGLINE']"" D
...S DGCTR=DGCTR+1
...S DGCTXT(DGCTR)=$E(DGNM_DGBLANK,1,30)_" "_$E(DGNUM_DGBLANK,1,15)_" "_$E(DGLINE_DGBLANK,1,10)
;
MAIL1 D ^XMD
D MES^XPDUTL(" >> message sent.")
K ^XTMP("DG53130P")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53130P 3896 printed Aug 26, 2025@22:51:42 Page 2
DG53130P ;ALB/SEK INCORRECT COPAY STATUS CLEANUP POST-INS ; 06/24/97
+1 ;;5.3;Registration;**130**;Aug 13, 1993
+2 ;
+3 ;This routine will be run as post-installation for patch DG*5.3*130.
+4 ;This routine will change the STATUS field (#.03) to 8 (non-exempt)
+5 ;from 9 (incomplete) in the ANNUAL MEANS TEST file (#408.13) for
+6 ;copay tests when the veteran declines to give income information.
+7 ;
POST ;entry point for post-install, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DGTTDT","EN^DG53130P",-9999999)
+3 QUIT
+4 ;
EN ;begin processing
+1 ;
+2 ;update PACKAGE file for installation of IVM patch IVM*2*8
+3 DO UPDATE
+4 ;
+5 ;go through ANNUAL MEANS TEST file changing STATUS to 8 from 9
+6 ;for copay tests when veteran declines to give income information.
+7 NEW DGTTDT
+8 ;
+9 DO BMES^XPDUTL(" >> Copay incomplete status cleanup")
+10 ;
+11 ;get value from checkpoints, previous run
+12 SET DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
+13 ;
+14 DO LOOP
+15 DO MAIL
+16 QUIT
+17 ;
+18 ;
UPDATE ; update PACKAGE file for install of IVM patch IVM*2*8
+1 NEW PKG,VER,PATCH
+2 ; find ien of IVM in PACKAGE file
+3 SET PKG=$ORDER(^DIC(9.4,"B","INCOME VERIFICATION MATCH",0))
if 'PKG
QUIT
+4 ; version
SET VER="2.0"
+5 ; patch #^today^installed by
SET PATCH="8^"_DT_"^"_DUZ
+6 ;
+7 DO BMES^XPDUTL(" >>Updating Patch Application History for IVM with IVM*2*8")
+8 SET PATCH=$$PKGPAT^XPDIP(PKG,VER,.PATCH)
+9 QUIT
+10 ;
+11 ;
LOOP ;
+1 NEW DFN,DGFL,DGFLD,DGIEN,DGINY,DGMTA,DGVAL,%
+2 ;temp array
SET ^XTMP("DG53130P",0)=$$FMADD^XLFDT(DT+30)_"^"_DT_"^"_"COPAY STATUS CHANGED LOG"
+3 FOR
SET DGTTDT=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT))
if 'DGTTDT
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT,DFN))
if 'DFN
QUIT
Begin DoDot:2
+5 SET DGIEN=0
FOR
SET DGIEN=$ORDER(^DGMT(408.31,"AS",2,9,DGTTDT,DFN,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:3
+6 SET DGMTA=$GET(^DGMT(408.31,DGIEN,0))
if 'DGMTA
QUIT
+7 if '$PIECE(DGMTA,"^",14)
QUIT
+8 SET DGFL=408.31
SET DGFLD=.03
SET DGVAL=9
DO KILL^DGMTR
+9 SET DGVAL=8
SET $PIECE(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL
DO SET^DGMTR
+10 ;
+11 ;get income year
+12 SET Y=$EXTRACT(DGTTDT,2,4)
SET Y=Y-1
XECUTE ^DD("DD")
SET DGINY=Y
+13 ;
+14 ; - build list of copay tests changed
+15 DO BUILDLN
+16 ;
End DoDot:3
End DoDot:2
+17 ;update checkpoint
+18 SET %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
End DoDot:1
+19 QUIT
+20 ;
+21 ;
+22 ;
BUILDLN ; Build storage array with data
+1 ;
+2 ; Output:
+3 ; ^XTMP("DG53130P",pt name,pt ssn,income year)=""
+4 ;
+5 NEW DGNAME,DGSSN
+6 ;
+7 ; - pt name and ssn from Patient (#2) file
+8 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
SET DGSSN=$PIECE($GET(^(.36)),"^",3)
+9 if DGNAME=""
SET DGNAME=DFN
+10 if DGSSN=""
SET DGSSN="MISSING"
+11 ;
+12 SET ^XTMP("DG53130P",DGNAME,DGSSN,DGINY)=""
+13 QUIT
+14 ;
+15 ;
MAIL ; Send a mailman msg to user listing copay tests with status change
+1 NEW DIFROM,%
+2 NEW DGCTR,DGCTXT,DGCX,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
+3 DO BMES^XPDUTL(" >> cleanup done.")
+4 DO BMES^XPDUTL(" >> Sending mailman msg listing copay tests with status change.")
+5 SET XMSUB="LIST OF COPAY TESTS WITH STATUS CHANGE"
+6 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+7 SET XMTEXT="DGCTXT("
+8 SET DGCX=$$SITE^VASITE
+9 DO NOW^%DTC
SET Y=%
DO DD^%DT
+10 SET DGCTXT(1)="LIST OF COPAY TESTS WITH STATUS CHANGE FROM INCOMPLETE TO NON-EXEMPT"
+11 SET DGCTXT(2)=" WHEN THE PATIENT DECLINES TO GIVE INCOME INFORMATION"
+12 SET DGCTXT(3)=" "
+13 IF $ORDER(^XTMP("DG53130P",0))']""
Begin DoDot:1
+14 SET DGCTXT(4)="No copay tests changed."
+15 SET DGCTXT(5)=" "
End DoDot:1
GOTO MAIL1
+16 SET DGCTXT(4)="Patient Name Patient SSN Income Year"
+17 SET DGCTXT(5)="============================================================"
+18 ;
+19 ; - create list of patients
+20 NEW DGBLANK,DGLINE,DGNM,DGNUM
+21 SET DGBLANK=""
SET $PIECE(DGBLANK," ",30)=""
SET DGCTR=8
+22 SET DGNM=""
FOR
SET DGNM=$ORDER(^XTMP("DG53130P",DGNM))
if DGNM']""
QUIT
Begin DoDot:1
+23 SET DGNUM=""
FOR
SET DGNUM=$ORDER(^XTMP("DG53130P",DGNM,DGNUM))
if DGNUM']""
QUIT
Begin DoDot:2
+24 SET DGLINE=""
FOR
SET DGLINE=$ORDER(^XTMP("DG53130P",DGNM,DGNUM,DGLINE))
if DGLINE']""
QUIT
Begin DoDot:3
+25 SET DGCTR=DGCTR+1
+26 SET DGCTXT(DGCTR)=$EXTRACT(DGNM_DGBLANK,1,30)_" "_$EXTRACT(DGNUM_DGBLANK,1,15)_" "_$EXTRACT(DGLINE_DGBLANK,1,10)
End DoDot:3
End DoDot:2
End DoDot:1
+27 ;
MAIL1 DO ^XMD
+1 DO MES^XPDUTL(" >> message sent.")
+2 KILL ^XTMP("DG53130P")
+3 QUIT
