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 ---[H[J[2J[HGMRC104 1325 printed Nov 22, 2024@16:54:50 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
