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

DG53130P.m

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