- 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 Jan 18, 2025@03:34: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