- 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 Feb 18, 2025@23:34:22 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