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