DG53672C.m

DG53672C ;ALB/BRM,LBD,ERC;DG*5.3*672 CLEAN-UP UTILITIES ; 8/16/05 12:12pm

 ;;5.3;Registration;**672**;Aug 13,1993

 ;;

 ; This routine will be used to loop through Patient File (#2) entries

 ; and will call all necessary clean-up routines.

 ;

QUE ; Que job to run

 N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO

 ;

 D BMES^XPDUTL("This process will perform the following clean-up activities:")

 D BMES^XPDUTL("   1) Find and delete all Reimbursable Insurance Other Eligibility")

 D MES^XPDUTL("      Codes on patients that are not deceased.  A Mailman message")

 D MES^XPDUTL("      will be sent upon completion of this job containing a summary")

 D MES^XPDUTL("      of the clean-up results.")

 ;

 ;

 D BMES^XPDUTL("   2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")

 D MES^XPDUTL("      to the corresponding value in field .3603, Discharge Due to Disability.")

 D MES^XPDUTL("      Convert data in Patient file field .362, Disability Ret. from Military")

 D MES^XPDUTL("      if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")

 D MES^XPDUTL("      Retirement and field .3603, Discharge Due to Disability.")

 ;

 D MES^XPDUTL("      ")

 ; 

 S ZTRTN="FIND^DG53672C",ZTIO="",ZTDTH=$$NOW^XLFDT()

 S ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"

 D ^%ZTLOAD,HOME^%ZIS

 I '$G(ZTSK) D BMES^XPDUTL("Clean-up was not tasked.") Q

 D BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)

 Q

 ;

FIND ; entry point

 ;

 N DFN,RIELIG,X1,X2,X

 ;

 K ^XTMP("DG53672C")

 S X1=DT,X2=90 D C^%DTC

 S ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"

 S ^XTMP("DG53672C",0,"TASK")=$G(ZTSK)

 ; Reimbursible Other EC Clean-up Process Setup

 D RSETUP^DG53672R(.RIELIG)

 ;

 S DFN=0

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D

 .S ^XTMP("DG53672C","TCNT")=$G(^XTMP("DG53672C","TCNT"))+1

 .;

 .; process reimbursable insurance other EC deletions

 .D REIM^DG53672R(DFN,.RIELIG)

 .;

 .;convert Disability Discharge on 1010EZ

 .D EN^DG53672D(DFN)

 ;

 S $P(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT

 ;

 ; send message for Reimbursable Insur. Job

 D SNDMSG^DG53672R

 ;send message for disability discharge data conversion

 D SNDMSG^DG53672D

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53672C   2221     printed  Apr 09, 2024@21:42:24                                                                                                                                                                                                    Page 2

DG53672C  ;ALB/BRM,LBD,ERC;DG*5.3*672 CLEAN-UP UTILITIES ; 8/16/05 12:12pm

 +1       ;;5.3;Registration;**672**;Aug 13,1993

 +2       ;;

 +3       ; This routine will be used to loop through Patient File (#2) entries

 +4       ; and will call all necessary clean-up routines.

 +5       ;

QUE       ; Que job to run

 +1        NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO

 +2       ;

 +3        DO BMES^XPDUTL("This process will perform the following clean-up activities:")

 +4        DO BMES^XPDUTL("   1) Find and delete all Reimbursable Insurance Other Eligibility")

 +5        DO MES^XPDUTL("      Codes on patients that are not deceased.  A Mailman message")

 +6        DO MES^XPDUTL("      will be sent upon completion of this job containing a summary")

 +7        DO MES^XPDUTL("      of the clean-up results.")

 +8       ;

 +9       ;

 +10       DO BMES^XPDUTL("   2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")

 +11       DO MES^XPDUTL("      to the corresponding value in field .3603, Discharge Due to Disability.")

 +12       DO MES^XPDUTL("      Convert data in Patient file field .362, Disability Ret. from Military")

 +13       DO MES^XPDUTL("      if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")

 +14       DO MES^XPDUTL("      Retirement and field .3603, Discharge Due to Disability.")

 +15      ;

 +16       DO MES^XPDUTL("      ")

 +17      ; 

 +18       SET ZTRTN="FIND^DG53672C"

           SET ZTIO=""

           SET ZTDTH=$$NOW^XLFDT()

 +19       SET ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"

 +20       DO ^%ZTLOAD

           DO HOME^%ZIS

 +21       IF '$GET(ZTSK)

               DO BMES^XPDUTL("Clean-up was not tasked.")

               QUIT 

 +22       DO BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)

 +23       QUIT 

 +24      ;

FIND      ; entry point

 +1       ;

 +2        NEW DFN,RIELIG,X1,X2,X

 +3       ;

 +4        KILL ^XTMP("DG53672C")

 +5        SET X1=DT

           SET X2=90

           DO C^%DTC

 +6        SET ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"

 +7        SET ^XTMP("DG53672C",0,"TASK")=$GET(ZTSK)

 +8       ; Reimbursible Other EC Clean-up Process Setup

 +9        DO RSETUP^DG53672R(.RIELIG)

 +10      ;

 +11       SET DFN=0

 +12       FOR 

               SET DFN=$ORDER(^DPT(DFN))

               if 'DFN

                   QUIT 

               Begin DoDot:1

 +13               SET ^XTMP("DG53672C","TCNT")=$GET(^XTMP("DG53672C","TCNT"))+1

 +14      ;

 +15      ; process reimbursable insurance other EC deletions

 +16               DO REIM^DG53672R(DFN,.RIELIG)

 +17      ;

 +18      ;convert Disability Discharge on 1010EZ

 +19               DO EN^DG53672D(DFN)

               End DoDot:1

 +20      ;

 +21       SET $PIECE(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT

 +22      ;

 +23      ; send message for Reimbursable Insur. Job

 +24       DO SNDMSG^DG53672R

 +25      ;send message for disability discharge data conversion

 +26       DO SNDMSG^DG53672D

 +27       QUIT