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