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

DG53296.m

Go to the documentation of this file.
  1. DG53296 ;ALB/JAT DG*5.3*296 POST-INSTALL TO MAILMAN MSG;01 JUNE 2000
  1. ;;5.3;Registration;**296**;JUNE 1 2000
  1. ;
  1. ; This routine is the post-installation for patch DG*5.3*296
  1. ;
  1. ; This clean up is required as there is a number of redundant entries
  1. ; in the Annual Means Test file for patients on a single date. These
  1. ; were created due to the MTS's previous ability to order multiple
  1. ; income test per patient per day.
  1. ;
  1. ; A modified version of the DG MEANS TEST DRIVER protocol is called.
  1. ;
  1. ; Calls:
  1. ; DG53296M
  1. ; DG53296D
  1. ; XPDUTL
  1. ;
  1. ; ^XTMP("DG-AMTIY",AMTIY) track number of records processed:
  1. ; ^XTMP("DG-AMTERR") contains error messages returned from FM DBS calls:
  1. ; ^XTMP("DG-AMTERR",file#,record#,field#,n)=error message
  1. ;
  1. POST ;
  1. ; post-install set up checkpoints and tracking global...
  1. N %,I,X,X1,X2,DGCNT,DGPCT,DGPRIM,DGSRC,IEN,SRC
  1. I $D(XPDNM) D
  1. .; checkpoints
  1. .I $$VERCP^XPDUTL("DGDFN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGDFN","",0)
  1. .I $$VERCP^XPDUTL("DGDTE")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGDTE","",0)
  1. .;
  1. ;
  1. ; initialize tracking global (see text above for description)...
  1. F I="AMTIY","AMTERR" D
  1. .I $D(^XTMP(I)) Q
  1. .S X1=DT
  1. .S X2=30
  1. .D C^%DTC
  1. .S ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*296 POST-INSTALL "
  1. .S ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$S(I="AMTIY":"record count",1:"filing errors")
  1. ;
  1. EN ; begin processing...
  1. N %
  1. ; check status and if root checkpoint has not completed start clean up
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("DGDFN")
  1. I $G(%)="" S %=0
  1. I %=0 D EN1
  1. Q
  1. ;
  1. EN1 ; begin purge...
  1. ; write message to installation device and to INSTALL file (#9.7)
  1. D BMES^XPDUTL("POST INSTALLATION PROCESSING")
  1. D MES^XPDUTL("Once the post-install is completed, a mail message will")
  1. D MES^XPDUTL("be sent that will report the count of records, by income")
  1. D MES^XPDUTL("year, from which means test entries were purged.")
  1. D MES^XPDUTL("Additionally, the report will contain notes")
  1. D MES^XPDUTL("about any errors encountered during the post-installation.")
  1. D BMES^XPDUTL("Beginning purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. ;
  1. ; process control body
  1. N DGDFN,DGIEN,DGDTE,MTIEN,ERRS
  1. ;
  1. I '$D(XPDNM) S DGDFN=""
  1. E S DGDFN=$$PARCP^XPDUTL("DGDFN"),DGDTE=$$PARCP^XPDUTL("DGDTE")
  1. ;
  1. ;Begin loop search by patient.
  1. F S DGDFN=$O(^DGMT(408.31,"AD",1,DGDFN)) Q:'DGDFN D
  1. .;Now loop through dates
  1. .N ERRS
  1. .D DGDTE
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
  1. ; send mailman msg to user/HEC with results
  1. D MAIL^DG53296M
  1. I $D(XPDNM) S %=$$COMCP^XPDUTL("DGDTE")
  1. D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. Q
  1. ;
  1. DGDTE ;Loop through dates by patient.
  1. S:'$D(DGDTE) DGDTE=""
  1. F S DGDTE=$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE)) Q:'DGDTE D
  1. .;Now search for IEN by patient and date
  1. .D DGIEN
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDTE",DGDTE)
  1. Q
  1. ;
  1. DGIEN ;Loop through IEN numbers by patient and date.
  1. S (DGPCT,DGCNT)=0,DGIEN=""
  1. F S DGIEN=$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN)) Q:DGIEN="" D
  1. .;Quit if only 1 IEN number for this date
  1. .Q:'$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))&(DGCNT=0)
  1. .;Validate records to delete
  1. .D PREDEL
  1. Q
  1. ;
  1. PREDEL ;Validate records to delete
  1. ;Is test Primary? What is the source?
  1. S DGPRIM=$G(^DGMT(408.31,DGIEN,"PRIM"),0),DGSRC=$P($G(^DGMT(408.31,DGIEN,0)),U,23)
  1. ;Quit if non-primary test doesn't have a source of DCD or Other Facility
  1. D:(DGPRIM&DGSRC)!("^3^4^"[("^"_DGSRC_"^"))
  1. .;Increment counter
  1. .S DGCNT=DGCNT+1
  1. .;Build array for IEN with same patient and date.
  1. .S TMP(DGSRC,DGIEN)=DGPRIM
  1. .;Keep count of primary test
  1. .S DGPCT=DGPCT+TMP(DGSRC,DGIEN)
  1. ;Quit if there are more IEN's for this patient and date
  1. Q:$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))
  1. ;Remove the last record from array by source if no primary for date
  1. I DGPCT=0 F SRC=3,4 D:$D(TMP(SRC))
  1. .S IEN=""
  1. .S IEN=$O(TMP(SRC,IEN),-1) K TMP(SRC,IEN) Q
  1. ;Delete if test is Non-Primary
  1. F SRC=3,4 D:$D(TMP(SRC))
  1. .S IEN=""
  1. .F S IEN=$O(TMP(SRC,IEN)) Q:IEN="" D:'TMP(SRC,IEN) DELETE(IEN)
  1. .;If error then update temporary store
  1. .I $G(ERRS) M ^XTMP("DG-AMTERR")=ERRS
  1. ;Record delete complete, Kill array and quit
  1. K TMP
  1. Q
  1. ;
  1. DELETE(IEN1) ;Delete non-primary test with source of DCD or Other Facility.
  1. ; Input:
  1. ; IEN1 = Internal Entry Number from 408.31
  1. I '$$EN^DG53296D(IEN1) D
  1. .S ERRS(408.31,IEN1,"ALL")="Unable to delete means test" Q
  1. ; increment purged count for income year.
  1. D COUNT(DGDTE)
  1. Q
  1. ;
  1. COUNT(DATE) ; update process tracking mechanisms
  1. ; Input:
  1. ; DATE = inverse date from 408.31
  1. ;
  1. N %,IY
  1. S IY=$E(DATE,1,3)-1
  1. S ^XTMP("DG-AMTIY",IY)=+$G(^XTMP("DG-AMTIY",IY))+1
  1. Q