MAGIP365 ;HIE/ZEB - MAG*3.0*365 post-install routine ; 11 JUL 2024@13:06
;;3.0;IMAGING;**365**;July 11, 2024;Build 19
;; Per VA Directive 6402, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
POST ;post-install actions for MAG*3.0*365
;register protocols
D ADD^XPDPROT("OR EVSEND RA","MAG PRECACHE ORDER SIGNED")
D ADD^XPDPROT("RA EVSEND OR","MAG PRECACHE ORDER SIGNED")
;configure MAGCACHECFG mail group to invoke MAG CACHE SETTINGS UPDATE option
N DO,DD,DA,DLAYGO,DIC,X,RCSITE,RUNDT,ENDT,MNTHFRST,MNTHLAST
S RCSITE=$G(^XMB("NETNAME")) Q:RCSITE="" ;SITE DOMAIN NAME
S X="S.MAG CACHE SETTINGS UPDATE@"_RCSITE ;SERVER NAME WITH SITE DOMAIN NAME
S DA(1)=$O(^XMB(3.8,"B","MAGCACHECFG",0)) ;MAIL GROUP IEN
I $D(^XMB(3.8,DA(1),6,"B",$E(X,1,30))) Q ;abort if mail address already present
S DLAYGO=3.812,DIC(0)="L",DIC="^XMB(3.8,"_DA(1)_",6,"
D FILE^DICN ;
D RPCS
;rerun Imaging Site Utilitzation report extract that would have run from 1/1/26 to the beginning of the current month
D RESTASK^MAGQE4
S RUNDT=3260101
S ENDT=$$DT^XLFDT()
S $E(ENDT,6,7)="01" ;go back to first day of month
F D S RUNDT=$$FMADD2(RUNDT,,1) Q:$$FMDIFF^XLFDT(ENDT,RUNDT,1)<0
. D PREVMNTH(RUNDT,.MNTHFRST,.MNTHLAST)
. D AHISU^MAGQE2(MNTHFRST,MNTHLAST)
Q
BACKOUT ;restore (backout) actions for MAG*3.0*365
;unregister protocols
D DELETE^XPDPROT("OR EVSEND RA","MAG PRECACHE ORDER SIGNED")
D DELETE^XPDPROT("RA EVSEND OR","MAG PRECACHE ORDER SIGNED")
Q
RPCS ;register RPCs in OR CPRS GUI CHART
N RPC,I,D0,DIC,DA,X
S RPC(0)=6
S RPC(1)=$O(^XWB(8994,"B","VAFCTFU GET TREATING LIST",""))
S RPC(2)=$O(^XWB(8994,"B","VAFCTFU CONVERT DFN TO ICN",""))
S RPC(3)=$O(^XWB(8994,"B","VAFC LOCAL GETCORRESPONDINGIDS",""))
S RPC(4)=$O(^XWB(8994,"B","ORRCQLPT PTDEMOS",""))
S RPC(5)=$O(^XWB(8994,"B","DDR FILER",""))
S RPC(6)=$O(^XWB(8994,"B","DSIC DPT GET ICN",""))
;find IEN for OR CPRS GUI CHART
S D0=$O(^DIC(19,"B","OR CPRS GUI CHART",""))
Q:D0="" ;abort iff OR CPRS GUI CHART doesn't exist
;add RPCS to context
F I=1:1:RPC(0) D
. Q:RPC(I)="" ;abort if RPC doesn't exist
. Q:$O(^DIC(19,D0,"RPC","B",RPC(I),""))]"" ;abort if RPC in context already
. S DIC="^DIC(19,"_D0_",""RPC"","
. S DIC(0)="FL"
. S DA(1)=D0
. S X=RPC(I)
. K DO
. D FILE^DICN
Q
FMADD2(INDT,YEARS,MONTHS,DAYS,HOURS,MINS,SECS) ;manipulate a FileMan D/T
Q:$G(INDT)="" -1 ;INDT (REQ) - FileMan format D/T to manipulate
S YEARS=$G(YEARS,0) ;YEARS (OPT) - number of years to add (or subtract if negative)
S MONTHS=$G(MONTHS,0) ;MONTHS (OPT) - number of months to add (or subtract if negative)
S DAYS=$G(DAYS,0) ;DAYS (OPT) - number of days to add (or subtract if negative)
S HOURS=$G(HOURS,0) ;HOURS (OPT) - number of hours to add (or subtract if negative)
S MINS=$G(MINS,0) ;MINS (OPT) - number of minutes to add (or subtract if negative)
S SECS=$G(SECS,0) ;SECS (OPT) - number of seconds to add (or subtract if negative)
Q:(INDT<1410102)!(INDT>4141015.235959) -1 ;invalid FileMan DT
N DTCENTURY,DTYEAR,DTMONTH,OUTDT
;do year and month operations that aren't supported by FMADD^XLFDT
S DTCENTURY=$E(INDT,1,1)
S DTYEAR=$E(INDT,2,3)
S DTMONTH=$E(INDT,4,5)
S DTMONTH=DTMONTH+MONTHS
I DTMONTH<1 D
. S YEARS=YEARS-1
. S DTMONTH=12+DTMONTH
I DTMONTH>12 D
. S YEARS=YEARS+1
. S DTMONTH=DTMONTH-12
S DTYEAR=DTYEAR+YEARS
I DTYEAR<1 D
. S DTCENTURY=DTCENTURY-1
. S DTYEAR=100+DTYEAR
I DTYEAR>99 D
. S DTCENTURY=DTCENTURY+1
. S DTYEAR=DTYEAR-100
;reassemble the date and proceed to existing code
S OUTDT=DTCENTURY_$$RJ^XLFSTR(DTYEAR,2,"0")_$$RJ^XLFSTR(DTMONTH,2,"0")_$E(INDT,6,7)
S:INDT["." OUTDT=OUTDT_"."_$P(INDT,".",2)
Q $$FMADD^XLFDT(OUTDT,DAYS,HOURS,MINS,SECS)
PREVMNTH(INDT,FIRST,LAST) ;get first and last days of previous month
I $G(INDT)="" S (FIRST,LAST)=-1 Q ;INDT (REQ) - FileMan format D/T to get dates from previous month
;FIRST (OUT) - FileMan format D/T of first of previous month
;LAST (OUT) - FileMan format D/T of last of previous month
N TMPDT
S TMPDT=INDT
S $E(TMPDT,6,7)="01"
S LAST=$$FMADD^XLFDT(TMPDT,-1)
S FIRST=LAST
S $E(FIRST,6,7)="01"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGIP365 5156 printed May 25, 2026@12:10:07 Page 2
MAGIP365 ;HIE/ZEB - MAG*3.0*365 post-install routine ; 11 JUL 2024@13:06
+1 ;;3.0;IMAGING;**365**;July 11, 2024;Build 19
+2 ;; Per VA Directive 6402, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
POST ;post-install actions for MAG*3.0*365
+1 ;register protocols
+2 DO ADD^XPDPROT("OR EVSEND RA","MAG PRECACHE ORDER SIGNED")
+3 DO ADD^XPDPROT("RA EVSEND OR","MAG PRECACHE ORDER SIGNED")
+4 ;configure MAGCACHECFG mail group to invoke MAG CACHE SETTINGS UPDATE option
+5 NEW DO,DD,DA,DLAYGO,DIC,X,RCSITE,RUNDT,ENDT,MNTHFRST,MNTHLAST
+6 ;SITE DOMAIN NAME
SET RCSITE=$GET(^XMB("NETNAME"))
if RCSITE=""
QUIT
+7 ;SERVER NAME WITH SITE DOMAIN NAME
SET X="S.MAG CACHE SETTINGS UPDATE@"_RCSITE
+8 ;MAIL GROUP IEN
SET DA(1)=$ORDER(^XMB(3.8,"B","MAGCACHECFG",0))
+9 ;abort if mail address already present
IF $DATA(^XMB(3.8,DA(1),6,"B",$EXTRACT(X,1,30)))
QUIT
+10 SET DLAYGO=3.812
SET DIC(0)="L"
SET DIC="^XMB(3.8,"_DA(1)_",6,"
+11 ;
DO FILE^DICN
+12 DO RPCS
+13 ;rerun Imaging Site Utilitzation report extract that would have run from 1/1/26 to the beginning of the current month
+14 DO RESTASK^MAGQE4
+15 SET RUNDT=3260101
+16 SET ENDT=$$DT^XLFDT()
+17 ;go back to first day of month
SET $EXTRACT(ENDT,6,7)="01"
+18 FOR
Begin DoDot:1
+19 DO PREVMNTH(RUNDT,.MNTHFRST,.MNTHLAST)
+20 DO AHISU^MAGQE2(MNTHFRST,MNTHLAST)
End DoDot:1
SET RUNDT=$$FMADD2(RUNDT,,1)
if $$FMDIFF^XLFDT(ENDT,RUNDT,1)<0
QUIT
+21 QUIT
BACKOUT ;restore (backout) actions for MAG*3.0*365
+1 ;unregister protocols
+2 DO DELETE^XPDPROT("OR EVSEND RA","MAG PRECACHE ORDER SIGNED")
+3 DO DELETE^XPDPROT("RA EVSEND OR","MAG PRECACHE ORDER SIGNED")
+4 QUIT
RPCS ;register RPCs in OR CPRS GUI CHART
+1 NEW RPC,I,D0,DIC,DA,X
+2 SET RPC(0)=6
+3 SET RPC(1)=$ORDER(^XWB(8994,"B","VAFCTFU GET TREATING LIST",""))
+4 SET RPC(2)=$ORDER(^XWB(8994,"B","VAFCTFU CONVERT DFN TO ICN",""))
+5 SET RPC(3)=$ORDER(^XWB(8994,"B","VAFC LOCAL GETCORRESPONDINGIDS",""))
+6 SET RPC(4)=$ORDER(^XWB(8994,"B","ORRCQLPT PTDEMOS",""))
+7 SET RPC(5)=$ORDER(^XWB(8994,"B","DDR FILER",""))
+8 SET RPC(6)=$ORDER(^XWB(8994,"B","DSIC DPT GET ICN",""))
+9 ;find IEN for OR CPRS GUI CHART
+10 SET D0=$ORDER(^DIC(19,"B","OR CPRS GUI CHART",""))
+11 ;abort iff OR CPRS GUI CHART doesn't exist
if D0=""
QUIT
+12 ;add RPCS to context
+13 FOR I=1:1:RPC(0)
Begin DoDot:1
+14 ;abort if RPC doesn't exist
if RPC(I)=""
QUIT
+15 ;abort if RPC in context already
if $ORDER(^DIC(19,D0,"RPC","B",RPC(I),""))]""
QUIT
+16 SET DIC="^DIC(19,"_D0_",""RPC"","
+17 SET DIC(0)="FL"
+18 SET DA(1)=D0
+19 SET X=RPC(I)
+20 KILL DO
+21 DO FILE^DICN
End DoDot:1
+22 QUIT
FMADD2(INDT,YEARS,MONTHS,DAYS,HOURS,MINS,SECS) ;manipulate a FileMan D/T
+1 ;INDT (REQ) - FileMan format D/T to manipulate
if $GET(INDT)=""
QUIT -1
+2 ;YEARS (OPT) - number of years to add (or subtract if negative)
SET YEARS=$GET(YEARS,0)
+3 ;MONTHS (OPT) - number of months to add (or subtract if negative)
SET MONTHS=$GET(MONTHS,0)
+4 ;DAYS (OPT) - number of days to add (or subtract if negative)
SET DAYS=$GET(DAYS,0)
+5 ;HOURS (OPT) - number of hours to add (or subtract if negative)
SET HOURS=$GET(HOURS,0)
+6 ;MINS (OPT) - number of minutes to add (or subtract if negative)
SET MINS=$GET(MINS,0)
+7 ;SECS (OPT) - number of seconds to add (or subtract if negative)
SET SECS=$GET(SECS,0)
+8 ;invalid FileMan DT
if (INDT<1410102)!(INDT>4141015.235959)
QUIT -1
+9 NEW DTCENTURY,DTYEAR,DTMONTH,OUTDT
+10 ;do year and month operations that aren't supported by FMADD^XLFDT
+11 SET DTCENTURY=$EXTRACT(INDT,1,1)
+12 SET DTYEAR=$EXTRACT(INDT,2,3)
+13 SET DTMONTH=$EXTRACT(INDT,4,5)
+14 SET DTMONTH=DTMONTH+MONTHS
+15 IF DTMONTH<1
Begin DoDot:1
+16 SET YEARS=YEARS-1
+17 SET DTMONTH=12+DTMONTH
End DoDot:1
+18 IF DTMONTH>12
Begin DoDot:1
+19 SET YEARS=YEARS+1
+20 SET DTMONTH=DTMONTH-12
End DoDot:1
+21 SET DTYEAR=DTYEAR+YEARS
+22 IF DTYEAR<1
Begin DoDot:1
+23 SET DTCENTURY=DTCENTURY-1
+24 SET DTYEAR=100+DTYEAR
End DoDot:1
+25 IF DTYEAR>99
Begin DoDot:1
+26 SET DTCENTURY=DTCENTURY+1
+27 SET DTYEAR=DTYEAR-100
End DoDot:1
+28 ;reassemble the date and proceed to existing code
+29 SET OUTDT=DTCENTURY_$$RJ^XLFSTR(DTYEAR,2,"0")_$$RJ^XLFSTR(DTMONTH,2,"0")_$EXTRACT(INDT,6,7)
+30 if INDT["."
SET OUTDT=OUTDT_"."_$PIECE(INDT,".",2)
+31 QUIT $$FMADD^XLFDT(OUTDT,DAYS,HOURS,MINS,SECS)
PREVMNTH(INDT,FIRST,LAST) ;get first and last days of previous month
+1 ;INDT (REQ) - FileMan format D/T to get dates from previous month
IF $GET(INDT)=""
SET (FIRST,LAST)=-1
QUIT
+2 ;FIRST (OUT) - FileMan format D/T of first of previous month
+3 ;LAST (OUT) - FileMan format D/T of last of previous month
+4 NEW TMPDT
+5 SET TMPDT=INDT
+6 SET $EXTRACT(TMPDT,6,7)="01"
+7 SET LAST=$$FMADD^XLFDT(TMPDT,-1)
+8 SET FIRST=LAST
+9 SET $EXTRACT(FIRST,6,7)="01"
+10 QUIT
