GMRC104.m

GMRC104 ;SLC/GDU - FILE 123.5 CLEAN UP ;08/09/18 ; 10/4/18 5:06pm

 ;;3.0;CONSULT/REQUEST TRACKING;**104**;Aug 13, 2018;Build 9

 ;This routine is to:

 ;Locate orphan APC Index records, back them up to ^XTEMP, delete them

 ;

 ;Routine variables:

 ;GMRCC=Child Service IEN

 ;GMRCD=Child Service Data

 ;GMRCP=Parent Service IEN

 ;GMRCE=Entry in Parent Sub-service multiple

 ;%,%H,%I,X,X1,X2 = Variables used by ^%DTC

 ;^XTMP("GMRC104"=Stores orphan APC index records

 ;DTCREATE=Date ^XTMP("GMRC104" is created, date run

 ;DTPURGE=Date ^XTMP("GMRC104" to be purged, date run plus 90 days

 ;U="^" Field delimiter, set during log in

 ;

 ;Integrations Agreements Used

 ;IA # 10000   C^%DTC, NOW^%DTC

 Q

EN1 ;READING THE APC INDEX OF FILE 123.5

 N GMRCC,GMRCD,GMRCP,GMRCE

 N %,%H,%I,X,X1,X2,DTCREATE,DTPURGE

 D NOW^%DTC S (DTCREATE,X1)=X,X2=90

 D C^%DTC S DTPURGE=X

 S ^XTMP("GMRC104",0)=DTPURGE_U_DTCREATE_U_"ORPHAN APC INDEX RECORDS"

 S GMRCC=0

 F  S GMRCC=$O(^GMR(123.5,"APC",GMRCC)) Q:'+GMRCC  D

 . S GMRCP=0

 . F  S GMRCP=$O(^GMR(123.5,"APC",GMRCC,GMRCP)) Q:'+GMRCP  D

 .. S GMRCE=0

 .. F  S GMRCE=$O(^GMR(123.5,"APC",GMRCC,GMRCP,GMRCE)) Q:'+GMRCE  D

 ... I $L($G(^GMR(123.5,GMRCP,10,GMRCE,0))) Q

 ... S ^XTMP("GMRC104","APC",GMRCC,GMRCP,GMRCE)=""

 ... K ^GMR(123.5,"APC",GMRCC,GMRCP,GMRCE)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRC104   1325     printed  Apr 09, 2024@20:52:23                                                                                                                                                                                                     Page 2

GMRC104   ;SLC/GDU - FILE 123.5 CLEAN UP ;08/09/18 ; 10/4/18 5:06pm

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**104**;Aug 13, 2018;Build 9

 +2       ;This routine is to:

 +3       ;Locate orphan APC Index records, back them up to ^XTEMP, delete them

 +4       ;

 +5       ;Routine variables:

 +6       ;GMRCC=Child Service IEN

 +7       ;GMRCD=Child Service Data

 +8       ;GMRCP=Parent Service IEN

 +9       ;GMRCE=Entry in Parent Sub-service multiple

 +10      ;%,%H,%I,X,X1,X2 = Variables used by ^%DTC

 +11      ;^XTMP("GMRC104"=Stores orphan APC index records

 +12      ;DTCREATE=Date ^XTMP("GMRC104" is created, date run

 +13      ;DTPURGE=Date ^XTMP("GMRC104" to be purged, date run plus 90 days

 +14      ;U="^" Field delimiter, set during log in

 +15      ;

 +16      ;Integrations Agreements Used

 +17      ;IA # 10000   C^%DTC, NOW^%DTC

 +18       QUIT 

EN1       ;READING THE APC INDEX OF FILE 123.5

 +1        NEW GMRCC,GMRCD,GMRCP,GMRCE

 +2        NEW %,%H,%I,X,X1,X2,DTCREATE,DTPURGE

 +3        DO NOW^%DTC

           SET (DTCREATE,X1)=X

           SET X2=90

 +4        DO C^%DTC

           SET DTPURGE=X

 +5        SET ^XTMP("GMRC104",0)=DTPURGE_U_DTCREATE_U_"ORPHAN APC INDEX RECORDS"

 +6        SET GMRCC=0

 +7        FOR 

               SET GMRCC=$ORDER(^GMR(123.5,"APC",GMRCC))

               if '+GMRCC

                   QUIT 

               Begin DoDot:1

 +8                SET GMRCP=0

 +9                FOR 

                       SET GMRCP=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP))

                       if '+GMRCP

                           QUIT 

                       Begin DoDot:2

 +10                       SET GMRCE=0

 +11                       FOR 

                               SET GMRCE=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP,GMRCE))

                               if '+GMRCE

                                   QUIT 

                               Begin DoDot:3

 +12                               IF $LENGTH($GET(^GMR(123.5,GMRCP,10,GMRCE,0)))

                                       QUIT 

 +13                               SET ^XTMP("GMRC104","APC",GMRCC,GMRCP,GMRCE)=""

 +14                               KILL ^GMR(123.5,"APC",GMRCC,GMRCP,GMRCE)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       QUIT