GMRV2POS ;HIRMFO/FT-Clean up old DD and data nodes in 120.5
;;4.0;Vitals/Measurements;**2**;Apr 25, 1997
EN1 ; delete old data dictionary nodes in DD(120.505
; and delete any data in those fields
S X="ALERT^GMRV2POS",@^%ZOSF("TRAP")
S DA=.01,DIK="^DD(120.505,",GMRVFLAG=0,DA(1)=120.505
F S DA=$O(^DD(120.505,DA)) Q:'DA D
.W:'$D(ZTQUEUED) !,"Deleting ^DD(120.505,",DA
.D ^DIK S GMRVFLAG=1
.Q
I GMRVFLAG=1 S DA(1)=0 F S DA(1)=$O(^GMR(120.5,DA(1))) Q:'DA(1) S DA=0 F S DA=$O(^GMR(120.5,DA(1),5,DA)) Q:'DA D
.S GMRVNODE=$G(^GMR(120.5,DA(1),5,DA,0))
.Q:$G(GMRVNODE)=""
.Q:($P(GMRVNODE,U,2)=""&($P(GMRVNODE,U,3)="")&($P(GMRVNODE,U,4)=""))
.W:'$D(ZTQUEUED) !,"Fixing ^DD(120.5,"_DA(1)_",5,"_DA_",0)"
.S GMRVPCE1=$P(GMRVNODE,U,1)
.S ^GMR(120.5,DA(1),5,DA,0)=GMRVPCE1
.Q
K DA,DIK,GMRVFLAG,GMRVNODE,GMRVPCE1,X,Y
S:$D(ZTQUEUED) ZTREQ="@"
Q
QUEUE ; queue clean up to run in the background
S ZTDTH=$$HADD^XLFDT($H,"","","",60),ZTDESC="GMRV*4*2 DD/DATA CLEAN UP"
S ZTRTN="EN1^GMRV2POS",(ZTIO,ZTSAVE("DUZ"))=""
D ^%ZTLOAD
Q
ALERT ; Set up ALERT variables if clean up bombs out
S XQA(DUZ)="",XQAMSG="GMRV*4*2 DD/DATA CLEANUP HAS ABORTED"
D SETUP^XQALERT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRV2POS 1202 printed Nov 22, 2024@17:06:04 Page 2
GMRV2POS ;HIRMFO/FT-Clean up old DD and data nodes in 120.5
+1 ;;4.0;Vitals/Measurements;**2**;Apr 25, 1997
EN1 ; delete old data dictionary nodes in DD(120.505
+1 ; and delete any data in those fields
+2 SET X="ALERT^GMRV2POS"
SET @^%ZOSF("TRAP")
+3 SET DA=.01
SET DIK="^DD(120.505,"
SET GMRVFLAG=0
SET DA(1)=120.505
+4 FOR
SET DA=$ORDER(^DD(120.505,DA))
if 'DA
QUIT
Begin DoDot:1
+5 if '$DATA(ZTQUEUED)
WRITE !,"Deleting ^DD(120.505,",DA
+6 DO ^DIK
SET GMRVFLAG=1
+7 QUIT
End DoDot:1
+8 IF GMRVFLAG=1
SET DA(1)=0
FOR
SET DA(1)=$ORDER(^GMR(120.5,DA(1)))
if 'DA(1)
QUIT
SET DA=0
FOR
SET DA=$ORDER(^GMR(120.5,DA(1),5,DA))
if 'DA
QUIT
Begin DoDot:1
+9 SET GMRVNODE=$GET(^GMR(120.5,DA(1),5,DA,0))
+10 if $GET(GMRVNODE)=""
QUIT
+11 if ($PIECE(GMRVNODE,U,2)=""&($PIECE(GMRVNODE,U,3)="")&($PIECE(GMRVNODE,U,4)=""))
QUIT
+12 if '$DATA(ZTQUEUED)
WRITE !,"Fixing ^DD(120.5,"_DA(1)_",5,"_DA_",0)"
+13 SET GMRVPCE1=$PIECE(GMRVNODE,U,1)
+14 SET ^GMR(120.5,DA(1),5,DA,0)=GMRVPCE1
+15 QUIT
End DoDot:1
+16 KILL DA,DIK,GMRVFLAG,GMRVNODE,GMRVPCE1,X,Y
+17 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 QUIT
QUEUE ; queue clean up to run in the background
+1 SET ZTDTH=$$HADD^XLFDT($HOROLOG,"","","",60)
SET ZTDESC="GMRV*4*2 DD/DATA CLEAN UP"
+2 SET ZTRTN="EN1^GMRV2POS"
SET (ZTIO,ZTSAVE("DUZ"))=""
+3 DO ^%ZTLOAD
+4 QUIT
ALERT ; Set up ALERT variables if clean up bombs out
+1 SET XQA(DUZ)=""
SET XQAMSG="GMRV*4*2 DD/DATA CLEANUP HAS ABORTED"
+2 DO SETUP^XQALERT
+3 QUIT
