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

IVM20214P.m

Go to the documentation of this file. 
  1. IVM20214P ;ALB/KUM - IVM*2*214 INSTALL UTILITY;12/20/23 1:36pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**214**;21-OCT-94;Build 18
  1.  ;
  1. QUIT ;No direct entry
  1.  ;
  1.  ;---------------------------------------------------------------------------
  1.  ;Patch IVM*2.0*214: Environment, Pre-Install, and Post-Install entry points.
  1.  ;---------------------------------------------------------------------------
  1.  ;
  1.  ; Reference to BMES^XPDUTL supported by ICR #10141
  1.  ; Reference to MES^XPDUTL supported by ICR #10141
  1.  ; Reference to $$PATCH^XPDUTL in ICR #10141
  1.  ; Reference to ^XMD in ICR #10070
  1.  ;
  1. ENV ;Main entry point for Environment check
  1.  Q
  1.  ;
  1. PRE ;Main entry point for Pre-Install items
  1.  Q
  1.  ;
  1. POST ;Main entry point for Post-Install items
  1.  ;
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,IVMTEXT,ZTSK
  1.  D BMES^XPDUTL(">>> Beginning the IVM*2.0*214 Post-install routine...")
  1.  ;Check if the patch has previously run and data in ^XTMP("IVM20214P, if so quit out POST
  1.  I $$PATCH^XPDUTL("IVM*2.0*214"),$D(^XTMP("IVM20214P")) D  Q
  1.  . D BMES^XPDUTL("Patch has been previously installed and ^XTMP(""IVM20214P"" global contains")
  1.  . D BMES^XPDUTL(" deleted PHONE NUMBER [WORK] records.  Post-install will not be run again.")
  1.  . D BMES^XPDUTL(">>> Patch IVM*2.0*214 Post-install complete.")
  1.  D BMES^XPDUTL(" ")
  1.  D BMES^XPDUTL("   The Post Install will now process through the IVM PATIENT")
  1.  D BMES^XPDUTL("   (#301.5) File to remove PHONE NUMBER [WORK] entries.")
  1.  D BMES^XPDUTL(" ")
  1.  ;queue off job
  1.  S ZTRTN="POST1^IVM20214P"
  1.  S ZTDESC="IVM*2.0*214 Remove PHONE NUMBER [WORK] entries from IVM PATIENT (#301.5) File."
  1.  S ZTDTH=$$NOW^XLFDT
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK)'="" D
  1.  . S IVMTEXT(1)=""
  1.  . S IVMTEXT(2)="PHONE NUMBER [WORK] entries cleanup job queued."
  1.  . S IVMTEXT(3)="   The task number is "_$G(ZTSK)_"."
  1.  . S IVMTEXT(4)=""
  1.  . S IVMTEXT(5)="A Mailman Message containing job results will be sent to the installer."
  1.  I $G(ZTSK)="" D
  1.  . S IVMTEXT(1)=""
  1.  . S IVMTEXT(2)="*** PHONE NUMBER [WORK] entries cleanup job FAILED TO QUEUE. ***"
  1.  . S IVMTEXT(3)=""
  1.  . S IVMTEXT(4)="  - Submit a YOUR IT Services ticket with the Enterprise Service Desk"
  1.  . S IVMTEXT(5)="    for assistance."
  1.  D BMES^XPDUTL(.IVMTEXT)
  1.  D BMES^XPDUTL(">>> Patch IVM*2.0*214 Post-install complete.")
  1.  Q
  1.  ;
  1. POST1 ;Entry point to queue off job
  1.  N %,IVMCNT,IVMI,IVMJ,IVM0NODE,IVMDFN,IVM0DPT,IVMDA,IVMDEMO,IVMSTATE,IVMCNT,IVMDTE,IVMDTS
  1.  K ^XTMP("IVM20214P")
  1.  S ^XTMP("IVM20214P",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"PATCH IVM*2.0*214 CLEANUP PHONE NUMBER [WORK] ENTRIES FROM IVM PATIENT (#301.5) File"
  1.  S IVMCNT=0
  1.  D NOW^%DTC S Y=% D DD^%DT
  1.  S IVMDTS=Y
  1.  ;
  1.  ;
  1.  ; - get patients with demographic fields from ASEG x-ref
  1.  S IVMI=0 F  S IVMI=$O(^IVM(301.5,"ASEG","PID",IVMI)) Q:'IVMI  D
  1.  .S IVM0NODE=$G(^IVM(301.5,IVMI,0)) I IVM0NODE']"" Q
  1.  .S IVMDFN=+IVM0NODE,IVM0DPT=$G(^DPT(+IVMDFN,0)) I IVM0DPT']"" Q
  1.  .;
  1.  .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,"ASEG","PID",IVMI,IVMJ)) Q:'IVMJ  D
  1.  ..F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,IVMI,"IN",IVMJ,"DEM",IVMDA)) Q:'IVMDA  D
  1.  ...; - grab node with IVM-supplied data
  1.  ...S IVMDEMO=$G(^IVM(301.5,IVMI,"IN",IVMJ,"DEM",IVMDA,0)) I IVMDEMO="" Q
  1.  ...I +$P(IVMDEMO,"^")'=$O(^IVM(301.92,"B","PHONE NUMBER [WORK]",0)) Q
  1.  ...S IVMSTATE=$P(IVMDEMO,"^",2)
  1.  ...S IVMCNT=IVMCNT+1
  1.  ...S ^XTMP("IVM20214P",IVMCNT)=IVMDFN_"^"_IVMI_"^"_IVMJ_"^"_IVMDA_"^"_IVMSTATE
  1.  ...D DELENT^IVMLDEMU(IVMI,IVMJ,IVMDA)
  1.  ;
  1.  ;
  1.  ; job completed, perhaps with an error, capture stats and send mailman message
  1.  D NOW^%DTC S Y=% D DD^%DT
  1.  S IVMDTE=Y
  1.  ;
  1.  ; Place job data into ^XTMP Global
  1.  S ^XTMP("IVM20214P",$J,"IVMSTART")=$G(IVMDTS) ;job start date/time
  1.  S ^XTMP("IVM20214P",$J,"IVMEND")=$G(IVMDTE) ;job end date/time
  1.  S ^XTMP("IVM20214P",$J,"PHONE NUMBER [WORK] RECORDS CLEANED")=IVMCNT ; total records affected
  1.  ;
  1.  D MSG
  1.  Q
  1.  ;
  1. SCR(Y) ;Screen Logic to be called from IVM*2.0*214 build to merge entries from IVM DEMOGRAPHIC UPLOAD (#301.92) file
  1.  N IVMSET
  1.  S IVMSET=0
  1.  I (($P($G(^IVM(301.92,+Y,0)),U,2)["RF171PW")!($P($G(^IVM(301.92,+Y,0)),U,2)["PID13W")) S IVMSET=1
  1.  Q IVMSET
  1.  ; 
  1. MSG ; All data is collected in ^TMP("IVM20214P") - put together email message
  1.  N XMSUB,XMDUZ,XMY,XMTEXT,IVMMSG,IVMLN,IVMSITE
  1.  S IVMSITE=$$SITE^VASITE
  1.  S XMY(.5)=""
  1.  S XMY(DUZ)=""
  1.  S XMTEXT="IVMMSG("
  1.  S XMDUZ=.5,XMSUB="IVM*2.0*214-CLEANUP OF PHONE NUMBER [WORK] ENTRIES IN (#301.5)"
  1.  S IVMMSG($I(IVMLN))=""
  1.  S IVMMSG($I(IVMLN))="The job completed to clean PHONE NUMBER [WORK] records in the IVM PATIENT "
  1.  S IVMMSG($I(IVMLN))="(#301.5) File. ^XTMP(""IVM20214P"" global contains deleted records for "
  1.  S IVMMSG($I(IVMLN))="reference and the format is DFN^IEN OF #301.5^IEN OF SUBFILE #301.501^"
  1.  S IVMMSG($I(IVMLN))="IEN OF SUBFILE #301.511^PHONE NUMBER[WORK]."
  1.  S IVMMSG($I(IVMLN))=""
  1.  S IVMMSG($I(IVMLN))="Job Results:"
  1.  S IVMMSG($I(IVMLN))="------------"
  1.  S IVMMSG($I(IVMLN))="Facility Name: "_$P(IVMSITE,"^",2)
  1.  S IVMMSG($I(IVMLN))="Station Number: "_$P(IVMSITE,"^",3)
  1.  S IVMMSG($I(IVMLN))=""
  1.  S IVMMSG($I(IVMLN))="The process statistics:"
  1.  S IVMMSG($I(IVMLN))="Job Start Date/Time: "_$G(IVMDTS)
  1.  S IVMMSG($I(IVMLN))="  Job End Date/Time: "_$G(IVMDTE)
  1.  S IVMMSG($I(IVMLN))="Total PHONE NUMBER [WORK] records deleted: "_IVMCNT
  1.  S IVMMSG($I(IVMLN))=""
  1.  S IVMMSG($I(IVMLN))="NOTE: The global ^XTMP(""IVM20214P"") will be purged after 60 days."
  1.  S IVMMSG($I(IVMLN))=""
  1.  ; send mail message with results
  1.  ; Per the MailMan Developer Guide, the variable DIFROM should be NEW'd prior to making the call to ^XMD.
  1.  N DIFROM
  1.  D ^XMD
  1.  Q