RA44PST ;HOIFO/SWM-Post install ;1/20/04 11:52
;;5.0;Radiology/Nuclear Medicine;**44**;Mar 16, 1998
; This is the post-install routine for patch RA*5.0*44
;
; This routine may be deleted after the patch is installed.
;
; supported IA 1472 allows adding record to file 19.2
;
I '$D(XPDNM)#2 D EN^DDIOL("This entry point must be called from the KIDS installation -- Nothing Done.",,"!!,$C(7)") Q
N RABY,RADT,RAIEN19,RAWHEN,RAFLAG,RAERR,RAR,RATXT
N D1,M1,Y1,M2,Y2
S RATXT(1)=""
S RAIEN19=$O(^DIC(19,"B","RA PERFORMIN TASKLM",0))
I 'RAIEN19 D Q
. S RATXT(2)="** Option RA PERFORMIN TASKLM isn't installed into file 19, so nothing done. **"
. D MES^XPDUTL(.RATXT)
. Q
;
D OPTSTAT^XUTMOPT("RA PERFORMIN TASKLM",.RAR)
I $P($G(RAR(1)),U) D Q
. S RATXT(2)="** Option RA PERFORMIN TASKLM is already scheduled, so nothing done. **"
. D MES^XPDUTL(.RATXT)
. Q
;
; add option to file 19.2 for automatic rescheduling
I '$O(^DIC(19.2,"B",RAIEN19,0)) D
. S RAFLAG="L"
. S RATXT(2)="** Installing RA PERFORMIN TASKLM into file 19.2. **"
. D MES^XPDUTL(.RATXT)
. D SET15
. D RESCH^XUTMOPT("RA PERFORMIN TASKLM",RAWHEN,,RABY,RAFLAG,.RAERR)
. Q
;
N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN S ZTIO=""
S ZTRTN="SCHED^RA44PST"
S ZTDESC="RA*5.0*44 Schedule RA PERFORMIN TASKLM on 15th"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0) ;add 2 minutes to 'now'
D ^%ZTLOAD S RATXT(1)=" "
S RATXT(2)="RA*5.0*44 Scheduling RA PERFORMIN TASKLM in background."
S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"."
S RATXT(4)=" "
D MES^XPDUTL(.RATXT)
Q
SCHED ; schedule RA PERFORMIN TASKLM to run on 15th
N RABY,RADT,RAIEN19,RAWHEN,RAFLAG,RAERR,RAR
N D1,M1,Y1,M2,Y2
S ZTREQ="@"
D OPTSTAT^XUTMOPT("RA PERFORMIN TASKLM",.RAR)
I $P($G(RAR(1)),U) Q ; option already tasked
I '$D(RAR(1)) Q ; option not in file 19.2
D SET15
D RESCH^XUTMOPT("RA PERFORMIN TASKLM",RAWHEN,,RABY,,.RAERR)
Q
SET15 ; set some variables for scheduling task
S Y1=$E(DT,1,3),M1=$E(DT,4,5),D1=$E(DT,6,7)
S Y2=$S(M1="12":Y1+1,1:Y1),M2=$S(M1="12":"01",1:M1+1)
S:$L(M2)=1 M2="0"_M2
D:D1=15 TODAY D:D1<15 THISM D:D1>15 NEXTM
S RAWHEN=$$FMADD^XLFDT(RADT,,,5) ; add 5 mins to scheduled date
S RABY="1M(15)" ; every month on the 15th day
Q
TODAY ; today is the 15th
S RADT=$$NOW^XLFDT
Q
THISM ; this month on the 15th
S RADT=Y1_M1_"15."_$P(($$NOW^XLFDT),".",2)
Q
NEXTM ; next month on the 15th
S RADT=Y2_M2_"15."_$P(($$NOW^XLFDT),".",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA44PST 2479 printed Dec 13, 2024@02:33:19 Page 2
RA44PST ;HOIFO/SWM-Post install ;1/20/04 11:52
+1 ;;5.0;Radiology/Nuclear Medicine;**44**;Mar 16, 1998
+2 ; This is the post-install routine for patch RA*5.0*44
+3 ;
+4 ; This routine may be deleted after the patch is installed.
+5 ;
+6 ; supported IA 1472 allows adding record to file 19.2
+7 ;
+8 IF '$DATA(XPDNM)#2
DO EN^DDIOL("This entry point must be called from the KIDS installation -- Nothing Done.",,"!!,$C(7)")
QUIT
+9 NEW RABY,RADT,RAIEN19,RAWHEN,RAFLAG,RAERR,RAR,RATXT
+10 NEW D1,M1,Y1,M2,Y2
+11 SET RATXT(1)=""
+12 SET RAIEN19=$ORDER(^DIC(19,"B","RA PERFORMIN TASKLM",0))
+13 IF 'RAIEN19
Begin DoDot:1
+14 SET RATXT(2)="** Option RA PERFORMIN TASKLM isn't installed into file 19, so nothing done. **"
+15 DO MES^XPDUTL(.RATXT)
+16 QUIT
End DoDot:1
QUIT
+17 ;
+18 DO OPTSTAT^XUTMOPT("RA PERFORMIN TASKLM",.RAR)
+19 IF $PIECE($GET(RAR(1)),U)
Begin DoDot:1
+20 SET RATXT(2)="** Option RA PERFORMIN TASKLM is already scheduled, so nothing done. **"
+21 DO MES^XPDUTL(.RATXT)
+22 QUIT
End DoDot:1
QUIT
+23 ;
+24 ; add option to file 19.2 for automatic rescheduling
+25 IF '$ORDER(^DIC(19.2,"B",RAIEN19,0))
Begin DoDot:1
+26 SET RAFLAG="L"
+27 SET RATXT(2)="** Installing RA PERFORMIN TASKLM into file 19.2. **"
+28 DO MES^XPDUTL(.RATXT)
+29 DO SET15
+30 DO RESCH^XUTMOPT("RA PERFORMIN TASKLM",RAWHEN,,RABY,RAFLAG,.RAERR)
+31 QUIT
End DoDot:1
+32 ;
+33 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
SET ZTIO=""
+34 SET ZTRTN="SCHED^RA44PST"
+35 SET ZTDESC="RA*5.0*44 Schedule RA PERFORMIN TASKLM on 15th"
+36 ;add 2 minutes to 'now'
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0)
+37 DO ^%ZTLOAD
SET RATXT(1)=" "
+38 SET RATXT(2)="RA*5.0*44 Scheduling RA PERFORMIN TASKLM in background."
+39 if $GET(ZTSK)>0
SET RATXT(3)="Task: "_ZTSK_"."
+40 SET RATXT(4)=" "
+41 DO MES^XPDUTL(.RATXT)
+42 QUIT
SCHED ; schedule RA PERFORMIN TASKLM to run on 15th
+1 NEW RABY,RADT,RAIEN19,RAWHEN,RAFLAG,RAERR,RAR
+2 NEW D1,M1,Y1,M2,Y2
+3 SET ZTREQ="@"
+4 DO OPTSTAT^XUTMOPT("RA PERFORMIN TASKLM",.RAR)
+5 ; option already tasked
IF $PIECE($GET(RAR(1)),U)
QUIT
+6 ; option not in file 19.2
IF '$DATA(RAR(1))
QUIT
+7 DO SET15
+8 DO RESCH^XUTMOPT("RA PERFORMIN TASKLM",RAWHEN,,RABY,,.RAERR)
+9 QUIT
SET15 ; set some variables for scheduling task
+1 SET Y1=$EXTRACT(DT,1,3)
SET M1=$EXTRACT(DT,4,5)
SET D1=$EXTRACT(DT,6,7)
+2 SET Y2=$SELECT(M1="12":Y1+1,1:Y1)
SET M2=$SELECT(M1="12":"01",1:M1+1)
+3 if $LENGTH(M2)=1
SET M2="0"_M2
+4 if D1=15
DO TODAY
if D1<15
DO THISM
if D1>15
DO NEXTM
+5 ; add 5 mins to scheduled date
SET RAWHEN=$$FMADD^XLFDT(RADT,,,5)
+6 ; every month on the 15th day
SET RABY="1M(15)"
+7 QUIT
TODAY ; today is the 15th
+1 SET RADT=$$NOW^XLFDT
+2 QUIT
THISM ; this month on the 15th
+1 SET RADT=Y1_M1_"15."_$PIECE(($$NOW^XLFDT),".",2)
+2 QUIT
NEXTM ; next month on the 15th
+1 SET RADT=Y2_M2_"15."_$PIECE(($$NOW^XLFDT),".",2)
+2 QUIT
