Routine: GMRV2POS

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="@"

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRV2POS   1202     printed  Apr 23, 2025@18:10:23                                                                                                                                                                                                    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

GMRV2POS.m