MAGQBUT ;WOIFO/RMP,JSL - Imaging Background Processor Utilities ; 24 May 2016 11:16 AM
;;3.0;IMAGING;**7,8,48,20,39,168**;Mar 19, 2002;Build 18;May 24, 2016
;; Per VHA Directive 2004-038, 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
CHGSERV(RESULT,NOTIFY,WSOS,BPWS) ;
; RPC[MAGQ FS CHNGE]
; RESULT VALUES:-1=NO RG MEMBERS,0=BELOW RESERVE,1=ABOVE RESERVE*PURGE FACTOR,2=BETWEEN RESERVE AND RESERVE*PURGE FACTOR
; ^CWL-PHYSICAL REFERENCE^CWL-TOTAL SPACE^PURGE^%FREE SPACE^PURGE_GROUP_IEN^VERIFY^RGADVANCE
N SPACE,IEN,SIZE,CWL,MIN,CNT,TNODE,TINT,NOW,TLTIME,TOD,PLACE,TSPACE,TSIZE,AUTON,GROUP
N APP,PFACTOR,NG,WSIEN,X,OG
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S U="^",(SPACE,SIZE,CNT,TSPACE,TSIZE)=0,(RESULT,IEN,NG)="" ; T23
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S APP="MAGQ FS CHNGE: "_BPWS
S WSIEN=$O(^MAG(2006.8,"C",PLACE,BPWS,""))
S MIN=$$SPARM
S CWL=$$CWL^MAGBAPI(PLACE)
S (GROUP,OG)=$$GRP(PLACE)
D:SPACE>0 REPCWL(CWL,GROUP,.RESULT) ; Update Result with Current Write Group properties
S PFACTOR=$$GET1^DIQ(2006.1,PLACE,"60.5","E")
S PFACTOR=$S(+PFACTOR:+PFACTOR,1:2) ; If only one group default to 1
D SPRGE(WSIEN,PLACE,.RESULT) ; Check for Scheduled Purge
D SVERI(WSIEN,PLACE,.RESULT) ; Check for Scheduled Verifier
D RGADV(PLACE,.GROUP,.RESULT) ;Check for RG Advance (Scheduled RAID group advance)
I $P($G(^MAG(2006.1,PLACE,1)),U,10) D NAUTOW(PLACE,CWL,.SPACE,.SIZE,.RESULT,NOTIFY,GROUP) Q ;Cache balancing off
; Evaluate space for auto-write location update/should find group with space
F D FSP(MIN,.SPACE,.SIZE,.IEN,.TSPACE,.TSIZE,PLACE,GROUP,"") Q:IEN D Q:$P(RESULT,U,1)="-1" Q:GROUP=$$GRP(PLACE) Q:OG=GROUP
. S NG=$$NXTGP(PLACE,GROUP)
. I NG=GROUP D Q
. . D NGF(PLACE) ; Mail "Get_Next_RAID_Group_failure" message
. . I '$P($G(^MAG(2005.2,NG,7,0)),U,4) S $P(RESULT,U,1)="-1" ; ZERO MEMBER COUNT - T23
. . Q
. S GROUP=NG
. Q
I OG'=GROUP,$P(RESULT,U,8)'="" S $P(RESULT,U,8)="Automatic RGADVANCE"
Q:$P(RESULT,U,1)="-1"
I TSIZE D REPCWL(IEN,GROUP,.RESULT,TSPACE,TSIZE) ; %FREE SPACE
E S $P(RESULT,U,5)="0.00"
I +IEN'=CWL,IEN>0 D ; on Change event
. D SCWL(IEN,PLACE,GROUP,APP,DUZ) ; UPDATES SITE PARAMETER FILE WITH CURRENT WRITE AND GROUP LOCATIONS
. Q
; Evaluate space for auto purge contingencies for current RAID group
I TSIZE>0,(((TSPACE/TSIZE)*100)>(PFACTOR*MIN)) S $P(RESULT,U)=1 Q
S $P(RESULT,U)=$S('TSIZE:0,(((TSPACE/TSIZE)*100)>MIN):1,SPACE>0:2,1:0)
S $P(RESULT,U,2,3)=$P($G(^MAG(2005.2,+$P(^MAG(2006.1,PLACE,0),U,3),0)),U,1,2)
I ($P($G(^MAG(2006.1,PLACE,"BPPURGE")),U)&(SPACE>0)&($$GET1^DIQ(2006.8,WSIEN,"3","I")="1")) D Q ;AUTOPURGE IS ENABLED
. S NG=$$NXTGP(PLACE,GROUP,"1") ;NEXT PURGE CAPABLE GROUP
. I 'NG D NGF(PLACE) Q
. Q:($P(^MAG(2006.1,PLACE,"BPPURGE"),U,7))+4>$$DT^XLFDT ; Allow only 1 auto-purge per 4 days
. I ($$UPPER^MAGQE4(WSOS)'["SERVER") Q:(WSOS'[".6.2.") ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
. S $P(RESULT,U,4)="AUTO_PURGE"
. S $P(RESULT,U,6)=NG ;GROUP TO BE PURGED
. D DFNIQ^MAGQBPG1("","An automatic RAID Group purge has been initiated for the following",0,PLACE,"AUTO_RAID_GROUP_PURGE")
. D DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$P($G(^MAG(2005.2,NG,0)),U,1),0,PLACE,"AUTO_RAID_GROUP_PURGE")
. D DFNIQ^MAGQBPG1("","Auto_RAID_group_purge",1,PLACE,"AUTO_RAID_GROUP_PURGE")
. Q
I TSIZE>0,(((TSPACE/TSIZE)*100)>MIN) Q
D:(NOTIFY!(SPACE>0)) TMESS(SPACE,"VistA Imaging RAID storage is Critically Low",PLACE)
Q
TMESS(SPACE,TS,PLACE) ;Trigger a message
N TN,PC,SER S TN=$$GETMI^MAGQBUT5(TS,PLACE)
S PC=$P($G(^MAG(2006.1,PLACE,"BPPURGE")),U)
S SER=$$PURGES(PLACE)
Q:$$FMADD^XLFDT(+$P(TN,"^",2),"",+$P(TN,U,1),"","")>$$NOW^XLFDT
D ICCL^MAGQBUT1(CNT_U_TS_U_SPACE_U_PC_SER,$P(TN,"^",1)_" hours.",PLACE)
Q
PURGES(PLACE) ; BP Server Assigned to Auto-purge
N IEN,NAME,SER S (NAME,SER)=""
F S NAME=$O(^MAG(2006.8,"C",PLACE,NAME)) Q:NAME="" D Q:SER]""
. S IEN=$O(^MAG(2006.8,"C",PLACE,NAME,"")) Q:'IEN
. I $P($G(^MAG(2006.8,IEN,0)),U,4)=1 S SER=$P($G(^MAG(2006.8,IEN,1)),U,1)
. Q
Q SER
NXTGP(PL,GRP,FP) ; return sure the NEXT able group (Canonically sorted by name)
N INDX,TMP,GNAME
S INDX="",GNAME=$P($G(^MAG(2005.2,GRP,0)),U)
F S INDX=$O(^MAG(2005.2,"F",PL,"GRP",INDX)) Q:'INDX D
. Q:'$P($G(^MAG(2005.2,INDX,7,0)),U,4) ; ZERO MEMBER COUNT
. ; CHECK MEMBERS FOR ONLINE, READABLE, HASHED, AND SPACE
. Q:'$$GABLE(INDX,$G(FP))
. S TMP($P($G(^MAG(2005.2,INDX,0)),U),INDX)=""
. Q
Q:'$D(TMP) GRP
S INDX=$O(TMP(GNAME)) ;TRY NEXT GROUP NAME CANONICALLY CH
I INDX="" S INDX=$O(TMP("")) ; ELSE LOOP TO FIRST
S INDX=$S(INDX'="":$O(TMP(INDX,"")),1:"") ; IF ANY GROUPS QUALIFY
K TMP
Q $S(INDX'="":INDX,1:GRP)
GABLE(GR,FP) ; next group able (has online, readable, hashed)
N IEN,RESULT,MIN,SPACE,SIZE
S (IEN,RESULT,SPACE,SIZE)=0
S MIN=$$SPARM
F S IEN=$O(^MAG(2005.2,GR,7,"B",IEN)) Q:'IEN D
. Q:$P($G(^MAG(2005.2,IEN,0)),U,6,7)'="1^MAG" ; Not online/MAG
. Q:$P($G(^MAG(2005.2,IEN,1)),U,6)="1" ; Read-only
. Q:$P($G(^MAG(2005.2,IEN,0)),U,3)'>0 ; No total space reported
. Q:$P($G(^MAG(2005.2,IEN,0)),U,8)'="Y" ; Not hashed
. Q:$P($G(^MAG(2005.2,IEN,0)),U,2)[":" ;skip if it appears to be a local drive
. Q:$E($P($G(^MAG(2005.2,IEN,0)),U,2),1,2)'="\\" ; skip if not a normal share path address
. Q:('$G(FP)&'$$MAXSP(IEN,.SPACE,.SIZE,$G(^MAG(2005.2,IEN,0)),MIN))
. S RESULT="1"
. Q
Q RESULT
MAXSP(IEN,FS,SZ,NODE,MIN) ; Called from FSP (RPC[MAGQ FS CHNGE]CHGSERV:FSP)
N SPACE,SIZE
S SPACE=+$P(NODE,U,5),SIZE=+$P(NODE,U,3)
I SIZE>0,(((SPACE/SIZE)*100)>MIN),SPACE>FS D Q 1
. S FS=SPACE,SZ=SIZE
Q 0
SPARM() ;Site Parameter for PERCENT server space to be held in reserve
N VALUE
S VALUE=$P($G(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),1)),U,8)
Q $S(VALUE>0:VALUE,1:5)
SCWL(IEN,PLACE,GROUP,APP,DUZ) ; Sets updates the Current Write Location
N X,X2,CNT
Q:'$$VALRD(IEN,PLACE,GROUP)
S X=$$DT^XLFDT,X2=$$FMADD^XLFDT(X,30,"","","")
I '$D(^XTMP("MAGSCWL "_X,0)) D
. S ^XTMP("MAGSCWL "_X,0)=X2_"^"_X_"^"_"Recording current write location updates"
S ^XTMP("MAGSCWL "_X,$$NOW^XLFDT)="CWL: "_IEN_" ( "_$P($G(^MAG(2005.2,IEN,0)),U,1,2)_")^PLACE: "_PLACE_"^GROUP: "_GROUP_"^Application: "_$G(APP)_"^DUZ: "_DUZ
S $P(^MAG(2006.1,PLACE,0),U,10)=GROUP
S $P(^MAG(2006.1,PLACE,0),U,3)=IEN
S $P(^MAG(2006.1,PLACE,"PACS"),U,3)=IEN
Q
EGR(PL,GRP,ACTION) ; Edit Group Read Only
N INDX,ZNODE,NODE1
S INDX=0
F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
. S ZNODE=$G(^MAG(2005.2,INDX,0))
. Q:$P(ZNODE,U,10)'=PLACE
. Q:$P(ZNODE,U,6,7)'["1^MAG"
. Q:$P(ZNODE,U,9)="1" ;ROUTING SHARE
. S NODE1=$G(^MAG(2005.2,INDX,1))
. Q:$P(NODE1,U,8)'=GRP
. I ACTION="E" S $P(^MAG(2005.2,INDX,1),U,6)="0"
. E S $P(^MAG(2005.2,INDX,1),U,6)="1"
. Q
Q
GRP(PLACE) ;
Q $S(+$P($G(^MAG(2006.1,PLACE,0)),U,10):+$P($G(^MAG(2006.1,PLACE,0)),U,10),1:$$NXTGP(PLACE,0))
FSP(MIN,SPACE,SIZE,IEN,TSPACE,TSIZE,PLACE,GROUP,FILTER) ; Find Space called from (RPC[MAGQ FS CHNGE]CHGSERV)
N INDX,ZNODE,NODE1
S (INDX,TSPACE,TSIZE)=0
F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
. Q:'$$VALRD(INDX,PLACE,GROUP)
. S ZNODE=$G(^MAG(2005.2,INDX,0))
. S TSPACE=TSPACE+(+$P(ZNODE,U,5))
. S TSIZE=TSIZE+(+$P(ZNODE,U,3))
. S CNT=CNT+1
. Q:(+FILTER=INDX) ; Find a share within the group other than this one
. I $$MAXSP(INDX,.SPACE,.SIZE,ZNODE,MIN) S IEN=INDX
. Q
Q
VALRD(IEN,PLACE,GROUP) ;Validate Active RAID
N ZNODE,NODE1
S ZNODE=$G(^MAG(2005.2,IEN,0))
S NODE1=$G(^MAG(2005.2,IEN,1))
Q:$P(ZNODE,U,10)'=PLACE 0
I $D(GROUP),$P(NODE1,U,8)'=GROUP Q 0
Q:+$P(NODE1,U,6) 0 ;READ ONLY
Q:$P(ZNODE,U,6,7)'["1^MAG" 0
Q:$P(ZNODE,U,9)="1" 0 ;ROUTING SHARE
Q:$P(ZNODE,U,8)'="Y" 0 ;skip not hashed
Q:$P(ZNODE,U,2)[":" 0 ;skip if it appears to be a local drive - from testing
Q:$E($P(ZNODE,U,2),1,2)'="\\" 0 ; skip if not a normal share path address
Q 1
NGF(PLACE) ;
D DFNIQ^MAGQBPG1("","The get next raid group function failed!",0,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
D DFNIQ^MAGQBPG1("","Use your BP Network Location Manager to re-configure your RAID",0,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
D DFNIQ^MAGQBPG1("","Get_Next_RAID_Group_failure",1,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
Q
SPRGE(WSIEN,PLACE,RESULT) ; Scheduled Purge
N NG
;Check for scheduled purge
Q:'$$GET1^DIQ(2006.1,PLACE,"61","I") ; Check if Scheduled purge is enabled
Q:($$GET1^DIQ(2006.1,PLACE,"61.1","I")+1)>$$DT^XLFDT ;Check if activated today
I ($$UPPER^MAGQE4(WSOS)'["SERVER") Q:(WSOS'[".6.2.") ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER" ; workaround Win 2012
Q:'$$GET1^DIQ(2006.8,WSIEN,"3","I") ;Check if task is assigned to this BP WS
N T1,T2
;Adjust 24 hour time for Fileman format for Scheduled time (#61.4)
S T1="0000",T2=$$GET1^DIQ(2006.1,PLACE,"61.4","I"),T1=$E(T1,1,($L(T1)-$L(T2)))_T2
I $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($$GET1^DIQ(2006.1,PLACE,"61.3","I")_"."_T1) D
. S NG=$$NXTGP(PLACE,GROUP,"1") ; Next purge capable Group
. I 'NG D NGF(PLACE) Q ; Quit if next Raid Group not found
. S $P(RESULT,U,4)="SCHEDULED_PURGE"_"~"_$$GET1^DIQ(2006.1,PLACE,"61.3","I")
. S $P(RESULT,U,6)=NG
. D DFNIQ^MAGQBPG1("","A scheduled RAID group purge has been initiated for the following",0,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
. D DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$P($G(^MAG(2005.2,NG,0)),U,1),0,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
. D DFNIQ^MAGQBPG1("","Scheduled_RAID_group_purge",1,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
. Q
Q
SVERI(WSIEN,PLACE,RESULT) ; Scheduled Verify
Q:'$$GET1^DIQ(2006.1,PLACE,"62","I") ; Check if Scheduled Verify is enabled
Q:($$GET1^DIQ(2006.1,PLACE,"62.1","I")+1)>$$DT^XLFDT ;Check if activated today
I ($$UPPER^MAGQE4(WSOS)'["SERVER") Q:(WSOS'[".6.2.") ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
Q:'$$GET1^DIQ(2006.8,WSIEN,"4","I") ;Check if task is assigned to this BP WS
N T1,T2
S T1="0000",T2=$$GET1^DIQ(2006.1,PLACE,"62.4","I"),T1=$E(T1,1,($L(T1)-$L(T2)))_T2
I $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($$GET1^DIQ(2006.1,PLACE,"62.3","I")_"."_T1) D
. S $P(RESULT,U,7)="VERIFY"_"~"_$$GET1^DIQ(2006.1,PLACE,"62.3","I")
. Q
Q
NAUTOW(PLACE,CWL,SPACE,SIZE,RESULT,NOTIFY,GROUP) ; CACHE BALANCING OFF
; No Auto RG Advance if Auto write is off
S SPACE=+$P($G(^MAG(2005.2,CWL,0)),U,5),SIZE=+$P($G(^MAG(2005.2,CWL,0)),U,3)
I (SIZE>0),((SPACE/SIZE)*100)>MIN D Q ;Here is where % Reserve is returned ...need to add by group and by RAID set also GB
. S $P(RESULT,U)=1
. I SIZE S $P(RESULT,U,5)=$P(((SPACE/SIZE)*100),".")_"."_$E($P(((SPACE/SIZE)*100),".",2),1,2)
. E S $P(RESULT,U,5)="0.00"
. Q
I SIZE>0 S $P(RESULT,U,5)=$P(((SPACE/SIZE)*100),".")_"."_$E($P(((SPACE/SIZE)*100),".",2),1,2)
E S $P(RESULT,U,5)="0.00"
S $P(RESULT,U)=$S(SPACE>0:2,1:0)
S $P(RESULT,U,2,3)=$P(^MAG(2005.2,$P(^MAG(2006.1,PLACE,0),U,3),0),U,1,2)
I (($$GET1^DIQ(2006.1,PLACE,"61.1","I")+4)<$$DT^XLFDT) D ;Check if activated within 4 days
. I ($P($G(^MAG(2006.1,PLACE,"BPPURGE")),U)&(SPACE>0)&($$GET1^DIQ(2006.8,WSIEN,"3","I")="1")) D
. . I ($$UPPER^MAGQE4(WSOS)'["SERVER") Q:(WSOS'[".6.2.") ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
. . S $P(RESULT,U,4)="AUTO_PURGE",$P(RESULT,U,6)=GROUP
. . D DFNIQ^MAGQBPG1("","An automatic RAID Group purge has been initiated for the following",0,PLACE,"AUTO_RAID_GROUP_PURGE")
. . D DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$P($G(^MAG(2005.2,GROUP,0)),U,1),0,PLACE,"AUTO_RAID_GROUP_PURGE")
. . D DFNIQ^MAGQBPG1("","Auto_RAID_group_purge",1,PLACE,"AUTO_RAID_GROUP_PURGE")
. . Q
. Q
D:(NOTIFY!(SPACE>0)) TMESS(SPACE,"VistA Imaging RAID storage is Critically Low ",PLACE)
Q
RGADV(PLACE,GROUP,RESULT) ; Scheduled Raid Group Advance
N NODERG,NG,IEN,APP,SCH,T1,T2
S NODERG=$G(^MAG(2006.1,PLACE,"RGADVANCE"))
I $P(NODERG,U,1) D
. Q:'(+$P(NODERG,U,4))
. S T1="0000",T2=$P(NODERG,U,5),T1=$E(T1,1,($L(T1)-$L(T2)))_T2
. I $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($P(NODERG,U,4)_"."_T1) D
. . S NG=$$NXTGP(PLACE,GROUP) ;$$NXTGP returns null when no group with suitable space is found
. . I ((NG)&(NG'=GROUP)) D Q
. . . S GROUP=NG,IEN=""
. . . D FSP(MIN,.SPACE,.SIZE,.IEN,.TSPACE,.TSIZE,PLACE,GROUP,"")
. . . S APP="Scheduled RAID Group Advance"
. . . D SCWL(IEN,PLACE,GROUP,APP,DUZ)
. . . S $P(RESULT,U,8)="Scheduled RGADVANCE"
. . . D DFNIQ^MAGQBPG1("","A Scheduled RGADVANCE has completed",0,PLACE,APP)
. . . D DFNIQ^MAGQBPG1("","The Active RAID Group is now set to: "_$P(^MAG(2005.2,GROUP,0),U,1),0,PLACE,APP)
. . . D DFNIQ^MAGQBPG1("","Scheduled_RAID_Group_Advance",1,PLACE,APP)
. . . S $P(^MAG(2006.1,PLACE,"RGADVANCE"),U,3)=$$DT^XLFDT ; DATE OF LAST RG ADVANCE #63.2
. . . ;Allow singly scheduled RGAdvance,unschedule next if Frequency not set
. . . S $P(^MAG(2006.1,PLACE,"RGADVANCE"),U,4)=$S(+$P(NODERG,U,2)>0:$$FMADD^XLFDT($$DT^XLFDT,$P(NODERG,U,2),"","",""),1:"")
. . . Q
. . ; Else NOTIFY & QUIT
. . N MSG S MSG="The scheduled RAID Group Advance failed!"
. . D DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQ FS CHNGE")
. . S MSG="Scheduled_RAID_Group_Advance_failure!"
. . D DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQ FS CHNGE") ; Send
. . Q
. Q
Q
REPCWL(IEN,RG,RES,TSPACE,TSIZE) ; Update Result with Current Write Group properties
S $P(RES,U,2)="CWL: "_IEN_" RG: "_RG
S $P(RES,U,3)=TSPACE
S $P(RES,U,5)=$P(((TSPACE/TSIZE)*100),".")_"."_$E($P(((TSPACE/TSIZE)*100),".",2),1,2) ; %FREE SPACE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBUT 14354 printed Nov 22, 2024@17:18 Page 2
MAGQBUT ;WOIFO/RMP,JSL - Imaging Background Processor Utilities ; 24 May 2016 11:16 AM
+1 ;;3.0;IMAGING;**7,8,48,20,39,168**;Mar 19, 2002;Build 18;May 24, 2016
+2 ;; Per VHA Directive 2004-038, 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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
CHGSERV(RESULT,NOTIFY,WSOS,BPWS) ;
+1 ; RPC[MAGQ FS CHNGE]
+2 ; RESULT VALUES:-1=NO RG MEMBERS,0=BELOW RESERVE,1=ABOVE RESERVE*PURGE FACTOR,2=BETWEEN RESERVE AND RESERVE*PURGE FACTOR
+3 ; ^CWL-PHYSICAL REFERENCE^CWL-TOTAL SPACE^PURGE^%FREE SPACE^PURGE_GROUP_IEN^VERIFY^RGADVANCE
+4 NEW SPACE,IEN,SIZE,CWL,MIN,CNT,TNODE,TINT,NOW,TLTIME,TOD,PLACE,TSPACE,TSIZE,AUTON,GROUP
+5 NEW APP,PFACTOR,NG,WSIEN,X,OG
+6 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+7 ; T23
SET U="^"
SET (SPACE,SIZE,CNT,TSPACE,TSIZE)=0
SET (RESULT,IEN,NG)=""
+8 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+9 SET APP="MAGQ FS CHNGE: "_BPWS
+10 SET WSIEN=$ORDER(^MAG(2006.8,"C",PLACE,BPWS,""))
+11 SET MIN=$$SPARM
+12 SET CWL=$$CWL^MAGBAPI(PLACE)
+13 SET (GROUP,OG)=$$GRP(PLACE)
+14 ; Update Result with Current Write Group properties
if SPACE>0
DO REPCWL(CWL,GROUP,.RESULT)
+15 SET PFACTOR=$$GET1^DIQ(2006.1,PLACE,"60.5","E")
+16 ; If only one group default to 1
SET PFACTOR=$SELECT(+PFACTOR:+PFACTOR,1:2)
+17 ; Check for Scheduled Purge
DO SPRGE(WSIEN,PLACE,.RESULT)
+18 ; Check for Scheduled Verifier
DO SVERI(WSIEN,PLACE,.RESULT)
+19 ;Check for RG Advance (Scheduled RAID group advance)
DO RGADV(PLACE,.GROUP,.RESULT)
+20 ;Cache balancing off
IF $PIECE($GET(^MAG(2006.1,PLACE,1)),U,10)
DO NAUTOW(PLACE,CWL,.SPACE,.SIZE,.RESULT,NOTIFY,GROUP)
QUIT
+21 ; Evaluate space for auto-write location update/should find group with space
+22 FOR
DO FSP(MIN,.SPACE,.SIZE,.IEN,.TSPACE,.TSIZE,PLACE,GROUP,"")
if IEN
QUIT
Begin DoDot:1
+23 SET NG=$$NXTGP(PLACE,GROUP)
+24 IF NG=GROUP
Begin DoDot:2
+25 ; Mail "Get_Next_RAID_Group_failure" message
DO NGF(PLACE)
+26 ; ZERO MEMBER COUNT - T23
IF '$PIECE($GET(^MAG(2005.2,NG,7,0)),U,4)
SET $PIECE(RESULT,U,1)="-1"
+27 QUIT
End DoDot:2
QUIT
+28 SET GROUP=NG
+29 QUIT
End DoDot:1
if $PIECE(RESULT,U,1)="-1"
QUIT
if GROUP=$$GRP(PLACE)
QUIT
if OG=GROUP
QUIT
+30 IF OG'=GROUP
IF $PIECE(RESULT,U,8)'=""
SET $PIECE(RESULT,U,8)="Automatic RGADVANCE"
+31 if $PIECE(RESULT,U,1)="-1"
QUIT
+32 ; %FREE SPACE
IF TSIZE
DO REPCWL(IEN,GROUP,.RESULT,TSPACE,TSIZE)
+33 IF '$TEST
SET $PIECE(RESULT,U,5)="0.00"
+34 ; on Change event
IF +IEN'=CWL
IF IEN>0
Begin DoDot:1
+35 ; UPDATES SITE PARAMETER FILE WITH CURRENT WRITE AND GROUP LOCATIONS
DO SCWL(IEN,PLACE,GROUP,APP,DUZ)
+36 QUIT
End DoDot:1
+37 ; Evaluate space for auto purge contingencies for current RAID group
+38 IF TSIZE>0
IF (((TSPACE/TSIZE)*100)>(PFACTOR*MIN))
SET $PIECE(RESULT,U)=1
QUIT
+39 SET $PIECE(RESULT,U)=$SELECT('TSIZE:0,(((TSPACE/TSIZE)*100)>MIN):1,SPACE>0:2,1:0)
+40 SET $PIECE(RESULT,U,2,3)=$PIECE($GET(^MAG(2005.2,+$PIECE(^MAG(2006.1,PLACE,0),U,3),0)),U,1,2)
+41 ;AUTOPURGE IS ENABLED
IF ($PIECE($GET(^MAG(2006.1,PLACE,"BPPURGE")),U)&(SPACE>0)&($$GET1^DIQ(2006.8,WSIEN,"3","I")="1"))
Begin DoDot:1
+42 ;NEXT PURGE CAPABLE GROUP
SET NG=$$NXTGP(PLACE,GROUP,"1")
+43 IF 'NG
DO NGF(PLACE)
QUIT
+44 ; Allow only 1 auto-purge per 4 days
if ($PIECE(^MAG(2006.1,PLACE,"BPPURGE"),U,7))+4>$$DT^XLFDT
QUIT
+45 ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
IF ($$UPPER^MAGQE4(WSOS)'["SERVER")
if (WSOS'[".6.2.")
QUIT
+46 SET $PIECE(RESULT,U,4)="AUTO_PURGE"
+47 ;GROUP TO BE PURGED
SET $PIECE(RESULT,U,6)=NG
+48 DO DFNIQ^MAGQBPG1("","An automatic RAID Group purge has been initiated for the following",0,PLACE,"AUTO_RAID_GROUP_PURGE")
+49 DO DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$PIECE($GET(^MAG(2005.2,NG,0)),U,1),0,PLACE,"AUTO_RAID_GROUP_PURGE")
+50 DO DFNIQ^MAGQBPG1("","Auto_RAID_group_purge",1,PLACE,"AUTO_RAID_GROUP_PURGE")
+51 QUIT
End DoDot:1
QUIT
+52 IF TSIZE>0
IF (((TSPACE/TSIZE)*100)>MIN)
QUIT
+53 if (NOTIFY!(SPACE>0))
DO TMESS(SPACE,"VistA Imaging RAID storage is Critically Low",PLACE)
+54 QUIT
TMESS(SPACE,TS,PLACE) ;Trigger a message
+1 NEW TN,PC,SER
SET TN=$$GETMI^MAGQBUT5(TS,PLACE)
+2 SET PC=$PIECE($GET(^MAG(2006.1,PLACE,"BPPURGE")),U)
+3 SET SER=$$PURGES(PLACE)
+4 if $$FMADD^XLFDT(+$PIECE(TN,"^",2),"",+$PIECE(TN,U,1),"","")>$$NOW^XLFDT
QUIT
+5 DO ICCL^MAGQBUT1(CNT_U_TS_U_SPACE_U_PC_SER,$PIECE(TN,"^",1)_" hours.",PLACE)
+6 QUIT
PURGES(PLACE) ; BP Server Assigned to Auto-purge
+1 NEW IEN,NAME,SER
SET (NAME,SER)=""
+2 FOR
SET NAME=$ORDER(^MAG(2006.8,"C",PLACE,NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET IEN=$ORDER(^MAG(2006.8,"C",PLACE,NAME,""))
if 'IEN
QUIT
+4 IF $PIECE($GET(^MAG(2006.8,IEN,0)),U,4)=1
SET SER=$PIECE($GET(^MAG(2006.8,IEN,1)),U,1)
+5 QUIT
End DoDot:1
if SER]""
QUIT
+6 QUIT SER
NXTGP(PL,GRP,FP) ; return sure the NEXT able group (Canonically sorted by name)
+1 NEW INDX,TMP,GNAME
+2 SET INDX=""
SET GNAME=$PIECE($GET(^MAG(2005.2,GRP,0)),U)
+3 FOR
SET INDX=$ORDER(^MAG(2005.2,"F",PL,"GRP",INDX))
if 'INDX
QUIT
Begin DoDot:1
+4 ; ZERO MEMBER COUNT
if '$PIECE($GET(^MAG(2005.2,INDX,7,0)),U,4)
QUIT
+5 ; CHECK MEMBERS FOR ONLINE, READABLE, HASHED, AND SPACE
+6 if '$$GABLE(INDX,$GET(FP))
QUIT
+7 SET TMP($PIECE($GET(^MAG(2005.2,INDX,0)),U),INDX)=""
+8 QUIT
End DoDot:1
+9 if '$DATA(TMP)
QUIT GRP
+10 ;TRY NEXT GROUP NAME CANONICALLY CH
SET INDX=$ORDER(TMP(GNAME))
+11 ; ELSE LOOP TO FIRST
IF INDX=""
SET INDX=$ORDER(TMP(""))
+12 ; IF ANY GROUPS QUALIFY
SET INDX=$SELECT(INDX'="":$ORDER(TMP(INDX,"")),1:"")
+13 KILL TMP
+14 QUIT $SELECT(INDX'="":INDX,1:GRP)
GABLE(GR,FP) ; next group able (has online, readable, hashed)
+1 NEW IEN,RESULT,MIN,SPACE,SIZE
+2 SET (IEN,RESULT,SPACE,SIZE)=0
+3 SET MIN=$$SPARM
+4 FOR
SET IEN=$ORDER(^MAG(2005.2,GR,7,"B",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 ; Not online/MAG
if $PIECE($GET(^MAG(2005.2,IEN,0)),U,6,7)'="1^MAG"
QUIT
+6 ; Read-only
if $PIECE($GET(^MAG(2005.2,IEN,1)),U,6)="1"
QUIT
+7 ; No total space reported
if $PIECE($GET(^MAG(2005.2,IEN,0)),U,3)'>0
QUIT
+8 ; Not hashed
if $PIECE($GET(^MAG(2005.2,IEN,0)),U,8)'="Y"
QUIT
+9 ;skip if it appears to be a local drive
if $PIECE($GET(^MAG(2005.2,IEN,0)),U,2)["
QUIT
+10 ; skip if not a normal share path address
if $EXTRACT($PIECE($GET(^MAG(2005.2,IEN,0)),U,2),1,2)'="\\"
QUIT
+11 if ('$GET(FP)&'$$MAXSP(IEN,.SPACE,.SIZE,$GET(^MAG(2005.2,IEN,0)),MIN))
QUIT
+12 SET RESULT="1"
+13 QUIT
End DoDot:1
+14 QUIT RESULT
MAXSP(IEN,FS,SZ,NODE,MIN) ; Called from FSP (RPC[MAGQ FS CHNGE]CHGSERV:FSP)
+1 NEW SPACE,SIZE
+2 SET SPACE=+$PIECE(NODE,U,5)
SET SIZE=+$PIECE(NODE,U,3)
+3 IF SIZE>0
IF (((SPACE/SIZE)*100)>MIN)
IF SPACE>FS
Begin DoDot:1
+4 SET FS=SPACE
SET SZ=SIZE
End DoDot:1
QUIT 1
+5 QUIT 0
SPARM() ;Site Parameter for PERCENT server space to be held in reserve
+1 NEW VALUE
+2 SET VALUE=$PIECE($GET(^MAG(2006.1,$$PLACE^MAGBAPI(+$GET(DUZ(2))),1)),U,8)
+3 QUIT $SELECT(VALUE>0:VALUE,1:5)
SCWL(IEN,PLACE,GROUP,APP,DUZ) ; Sets updates the Current Write Location
+1 NEW X,X2,CNT
+2 if '$$VALRD(IEN,PLACE,GROUP)
QUIT
+3 SET X=$$DT^XLFDT
SET X2=$$FMADD^XLFDT(X,30,"","","")
+4 IF '$DATA(^XTMP("MAGSCWL "_X,0))
Begin DoDot:1
+5 SET ^XTMP("MAGSCWL "_X,0)=X2_"^"_X_"^"_"Recording current write location updates"
End DoDot:1
+6 SET ^XTMP("MAGSCWL "_X,$$NOW^XLFDT)="CWL: "_IEN_" ( "_$P($G(^MAG(2005.2,IEN,0)),U,1,2)_")^PLACE: "_PLACE_"^GROUP: "_GROUP_"^Application: "_$G(APP)_"^DUZ: "_DUZ
+7 SET $PIECE(^MAG(2006.1,PLACE,0),U,10)=GROUP
+8 SET $PIECE(^MAG(2006.1,PLACE,0),U,3)=IEN
+9 SET $PIECE(^MAG(2006.1,PLACE,"PACS"),U,3)=IEN
+10 QUIT
EGR(PL,GRP,ACTION) ; Edit Group Read Only
+1 NEW INDX,ZNODE,NODE1
+2 SET INDX=0
+3 FOR
SET INDX=$ORDER(^MAG(2005.2,INDX))
if INDX'?1N.N
QUIT
Begin DoDot:1
+4 SET ZNODE=$GET(^MAG(2005.2,INDX,0))
+5 if $PIECE(ZNODE,U,10)'=PLACE
QUIT
+6 if $PIECE(ZNODE,U,6,7)'["1^MAG"
QUIT
+7 ;ROUTING SHARE
if $PIECE(ZNODE,U,9)="1"
QUIT
+8 SET NODE1=$GET(^MAG(2005.2,INDX,1))
+9 if $PIECE(NODE1,U,8)'=GRP
QUIT
+10 IF ACTION="E"
SET $PIECE(^MAG(2005.2,INDX,1),U,6)="0"
+11 IF '$TEST
SET $PIECE(^MAG(2005.2,INDX,1),U,6)="1"
+12 QUIT
End DoDot:1
+13 QUIT
GRP(PLACE) ;
+1 QUIT $SELECT(+$PIECE($GET(^MAG(2006.1,PLACE,0)),U,10):+$PIECE($GET(^MAG(2006.1,PLACE,0)),U,10),1:$$NXTGP(PLACE,0))
FSP(MIN,SPACE,SIZE,IEN,TSPACE,TSIZE,PLACE,GROUP,FILTER) ; Find Space called from (RPC[MAGQ FS CHNGE]CHGSERV)
+1 NEW INDX,ZNODE,NODE1
+2 SET (INDX,TSPACE,TSIZE)=0
+3 FOR
SET INDX=$ORDER(^MAG(2005.2,INDX))
if INDX'?1N.N
QUIT
Begin DoDot:1
+4 if '$$VALRD(INDX,PLACE,GROUP)
QUIT
+5 SET ZNODE=$GET(^MAG(2005.2,INDX,0))
+6 SET TSPACE=TSPACE+(+$PIECE(ZNODE,U,5))
+7 SET TSIZE=TSIZE+(+$PIECE(ZNODE,U,3))
+8 SET CNT=CNT+1
+9 ; Find a share within the group other than this one
if (+FILTER=INDX)
QUIT
+10 IF $$MAXSP(INDX,.SPACE,.SIZE,ZNODE,MIN)
SET IEN=INDX
+11 QUIT
End DoDot:1
+12 QUIT
VALRD(IEN,PLACE,GROUP) ;Validate Active RAID
+1 NEW ZNODE,NODE1
+2 SET ZNODE=$GET(^MAG(2005.2,IEN,0))
+3 SET NODE1=$GET(^MAG(2005.2,IEN,1))
+4 if $PIECE(ZNODE,U,10)'=PLACE
QUIT 0
+5 IF $DATA(GROUP)
IF $PIECE(NODE1,U,8)'=GROUP
QUIT 0
+6 ;READ ONLY
if +$PIECE(NODE1,U,6)
QUIT 0
+7 if $PIECE(ZNODE,U,6,7)'["1^MAG"
QUIT 0
+8 ;ROUTING SHARE
if $PIECE(ZNODE,U,9)="1"
QUIT 0
+9 ;skip not hashed
if $PIECE(ZNODE,U,8)'="Y"
QUIT 0
+10 ;skip if it appears to be a local drive - from testing
if $PIECE(ZNODE,U,2)["
QUIT 0
+11 ; skip if not a normal share path address
if $EXTRACT($PIECE(ZNODE,U,2),1,2)'="\\"
QUIT 0
+12 QUIT 1
NGF(PLACE) ;
+1 DO DFNIQ^MAGQBPG1("","The get next raid group function failed!",0,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
+2 DO DFNIQ^MAGQBPG1("","Use your BP Network Location Manager to re-configure your RAID",0,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
+3 DO DFNIQ^MAGQBPG1("","Get_Next_RAID_Group_failure",1,PLACE,"GET_NEXT_RAID_GROUP_FAILURE")
+4 QUIT
SPRGE(WSIEN,PLACE,RESULT) ; Scheduled Purge
+1 NEW NG
+2 ;Check for scheduled purge
+3 ; Check if Scheduled purge is enabled
if '$$GET1^DIQ(2006.1,PLACE,"61","I")
QUIT
+4 ;Check if activated today
if ($$GET1^DIQ(2006.1,PLACE,"61.1","I")+1)>$$DT^XLFDT
QUIT
+5 ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER" ; workaround Win 2012
IF ($$UPPER^MAGQE4(WSOS)'["SERVER")
if (WSOS'[".6.2.")
QUIT
+6 ;Check if task is assigned to this BP WS
if '$$GET1^DIQ(2006.8,WSIEN,"3","I")
QUIT
+7 NEW T1,T2
+8 ;Adjust 24 hour time for Fileman format for Scheduled time (#61.4)
+9 SET T1="0000"
SET T2=$$GET1^DIQ(2006.1,PLACE,"61.4","I")
SET T1=$EXTRACT(T1,1,($LENGTH(T1)-$LENGTH(T2)))_T2
+10 IF $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($$GET1^DIQ(2006.1,PLACE,"61.3","I")_"."_T1)
Begin DoDot:1
+11 ; Next purge capable Group
SET NG=$$NXTGP(PLACE,GROUP,"1")
+12 ; Quit if next Raid Group not found
IF 'NG
DO NGF(PLACE)
QUIT
+13 SET $PIECE(RESULT,U,4)="SCHEDULED_PURGE"_"~"_$$GET1^DIQ(2006.1,PLACE,"61.3","I")
+14 SET $PIECE(RESULT,U,6)=NG
+15 DO DFNIQ^MAGQBPG1("","A scheduled RAID group purge has been initiated for the following",0,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
+16 DO DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$PIECE($GET(^MAG(2005.2,NG,0)),U,1),0,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
+17 DO DFNIQ^MAGQBPG1("","Scheduled_RAID_group_purge",1,PLACE,"SCHEDULED_RAID_GROUP_PURGE")
+18 QUIT
End DoDot:1
+19 QUIT
SVERI(WSIEN,PLACE,RESULT) ; Scheduled Verify
+1 ; Check if Scheduled Verify is enabled
if '$$GET1^DIQ(2006.1,PLACE,"62","I")
QUIT
+2 ;Check if activated today
if ($$GET1^DIQ(2006.1,PLACE,"62.1","I")+1)>$$DT^XLFDT
QUIT
+3 ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
IF ($$UPPER^MAGQE4(WSOS)'["SERVER")
if (WSOS'[".6.2.")
QUIT
+4 ;Check if task is assigned to this BP WS
if '$$GET1^DIQ(2006.8,WSIEN,"4","I")
QUIT
+5 NEW T1,T2
+6 SET T1="0000"
SET T2=$$GET1^DIQ(2006.1,PLACE,"62.4","I")
SET T1=$EXTRACT(T1,1,($LENGTH(T1)-$LENGTH(T2)))_T2
+7 IF $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($$GET1^DIQ(2006.1,PLACE,"62.3","I")_"."_T1)
Begin DoDot:1
+8 SET $PIECE(RESULT,U,7)="VERIFY"_"~"_$$GET1^DIQ(2006.1,PLACE,"62.3","I")
+9 QUIT
End DoDot:1
+10 QUIT
NAUTOW(PLACE,CWL,SPACE,SIZE,RESULT,NOTIFY,GROUP) ; CACHE BALANCING OFF
+1 ; No Auto RG Advance if Auto write is off
+2 SET SPACE=+$PIECE($GET(^MAG(2005.2,CWL,0)),U,5)
SET SIZE=+$PIECE($GET(^MAG(2005.2,CWL,0)),U,3)
+3 ;Here is where % Reserve is returned ...need to add by group and by RAID set also GB
IF (SIZE>0)
IF ((SPACE/SIZE)*100)>MIN
Begin DoDot:1
+4 SET $PIECE(RESULT,U)=1
+5 IF SIZE
SET $PIECE(RESULT,U,5)=$PIECE(((SPACE/SIZE)*100),".")_"."_$EXTRACT($PIECE(((SPACE/SIZE)*100),".",2),1,2)
+6 IF '$TEST
SET $PIECE(RESULT,U,5)="0.00"
+7 QUIT
End DoDot:1
QUIT
+8 IF SIZE>0
SET $PIECE(RESULT,U,5)=$PIECE(((SPACE/SIZE)*100),".")_"."_$EXTRACT($PIECE(((SPACE/SIZE)*100),".",2),1,2)
+9 IF '$TEST
SET $PIECE(RESULT,U,5)="0.00"
+10 SET $PIECE(RESULT,U)=$SELECT(SPACE>0:2,1:0)
+11 SET $PIECE(RESULT,U,2,3)=$PIECE(^MAG(2005.2,$PIECE(^MAG(2006.1,PLACE,0),U,3),0),U,1,2)
+12 ;Check if activated within 4 days
IF (($$GET1^DIQ(2006.1,PLACE,"61.1","I")+4)<$$DT^XLFDT)
Begin DoDot:1
+13 IF ($PIECE($GET(^MAG(2006.1,PLACE,"BPPURGE")),U)&(SPACE>0)&($$GET1^DIQ(2006.8,WSIEN,"3","I")="1"))
Begin DoDot:2
+14 ;;Q:$$UPPER^MAGQE4(WSOS)'["SERVER"
IF ($$UPPER^MAGQE4(WSOS)'["SERVER")
if (WSOS'[".6.2.")
QUIT
+15 SET $PIECE(RESULT,U,4)="AUTO_PURGE"
SET $PIECE(RESULT,U,6)=GROUP
+16 DO DFNIQ^MAGQBPG1("","An automatic RAID Group purge has been initiated for the following",0,PLACE,"AUTO_RAID_GROUP_PURGE")
+17 DO DFNIQ^MAGQBPG1("","VistA Imaging RAID group: "_$PIECE($GET(^MAG(2005.2,GROUP,0)),U,1),0,PLACE,"AUTO_RAID_GROUP_PURGE")
+18 DO DFNIQ^MAGQBPG1("","Auto_RAID_group_purge",1,PLACE,"AUTO_RAID_GROUP_PURGE")
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 if (NOTIFY!(SPACE>0))
DO TMESS(SPACE,"VistA Imaging RAID storage is Critically Low ",PLACE)
+22 QUIT
RGADV(PLACE,GROUP,RESULT) ; Scheduled Raid Group Advance
+1 NEW NODERG,NG,IEN,APP,SCH,T1,T2
+2 SET NODERG=$GET(^MAG(2006.1,PLACE,"RGADVANCE"))
+3 IF $PIECE(NODERG,U,1)
Begin DoDot:1
+4 if '(+$PIECE(NODERG,U,4))
QUIT
+5 SET T1="0000"
SET T2=$PIECE(NODERG,U,5)
SET T1=$EXTRACT(T1,1,($LENGTH(T1)-$LENGTH(T2)))_T2
+6 IF $$FMADD^XLFDT($$NOW^XLFDT,"","",20,"")>($PIECE(NODERG,U,4)_"."_T1)
Begin DoDot:2
+7 ;$$NXTGP returns null when no group with suitable space is found
SET NG=$$NXTGP(PLACE,GROUP)
+8 IF ((NG)&(NG'=GROUP))
Begin DoDot:3
+9 SET GROUP=NG
SET IEN=""
+10 DO FSP(MIN,.SPACE,.SIZE,.IEN,.TSPACE,.TSIZE,PLACE,GROUP,"")
+11 SET APP="Scheduled RAID Group Advance"
+12 DO SCWL(IEN,PLACE,GROUP,APP,DUZ)
+13 SET $PIECE(RESULT,U,8)="Scheduled RGADVANCE"
+14 DO DFNIQ^MAGQBPG1("","A Scheduled RGADVANCE has completed",0,PLACE,APP)
+15 DO DFNIQ^MAGQBPG1("","The Active RAID Group is now set to: "_$PIECE(^MAG(2005.2,GROUP,0),U,1),0,PLACE,APP)
+16 DO DFNIQ^MAGQBPG1("","Scheduled_RAID_Group_Advance",1,PLACE,APP)
+17 ; DATE OF LAST RG ADVANCE #63.2
SET $PIECE(^MAG(2006.1,PLACE,"RGADVANCE"),U,3)=$$DT^XLFDT
+18 ;Allow singly scheduled RGAdvance,unschedule next if Frequency not set
+19 SET $PIECE(^MAG(2006.1,PLACE,"RGADVANCE"),U,4)=$SELECT(+$PIECE(NODERG,U,2)>0:$$FMADD^XLFDT($$DT^XLFDT,$PIECE(NODERG,U,2),"","",""),1:"")
+20 QUIT
End DoDot:3
QUIT
+21 ; Else NOTIFY & QUIT
+22 NEW MSG
SET MSG="The scheduled RAID Group Advance failed!"
+23 DO DFNIQ^MAGQBPG1("",MSG,0,PLACE,"MAGQ FS CHNGE")
+24 SET MSG="Scheduled_RAID_Group_Advance_failure!"
+25 ; Send
DO DFNIQ^MAGQBPG1("",MSG,1,PLACE,"MAGQ FS CHNGE")
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
REPCWL(IEN,RG,RES,TSPACE,TSIZE) ; Update Result with Current Write Group properties
+1 SET $PIECE(RES,U,2)="CWL: "_IEN_" RG: "_RG
+2 SET $PIECE(RES,U,3)=TSPACE
+3 ; %FREE SPACE
SET $PIECE(RES,U,5)=$PIECE(((TSPACE/TSIZE)*100),".")_"."_$EXTRACT($PIECE(((TSPACE/TSIZE)*100),".",2),1,2)
+4 QUIT
