GMRCP210 ;ALB/JAS - GMRC*3.0*210 Post-Init Routine ; 07/29/2026 1:30PM
;;3.0;CONSULT/REQUEST TRACKING;**210**;DEC 27, 1997;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
TASK ; tasks off process to run the GMRC Consult file clean-up process
D MES^XPDUTL("")
D MES^XPDUTL(" GMRC*3.0*210 Post-Install to clean-up REQUEST/CONSULTATION (#123) file")
D MES^XPDUTL(" entries that have the incorrect user DUZ stored in the REQUEST PROCESSING")
D MES^XPDUTL(" ACTIVITY (#40) sub-file.")
D MES^XPDUTL("")
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
S ZTDESC="GMRC*3.0*210 Post Install Routine Task 1"
S ZTDTH=$P($H,",",1)_","_86399,ZTIO="",ZTRTN="REPORT^GMRCP210"
D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
REPORT ;
K ^XTMP("GMRCP210")
;
D CLEANUP
;
D MAIL
Q
;
MAIL ;
N STANUM,MESS1,PROD,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S PROD=$$PROD^XUPROD
S MESS1="Station: "_STANUM_" - "_" ("_$S(PROD:"PROD",1:"TEST")_") - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""GMRCP210"","
S XMSUB=MESS1_"GMRC*3.0*210 - Post Install Data Cleanup Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
I PROD D
. S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
. S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
D ^XMD
Q
;
CLEANUP ; Data clean-up for file #123 records that have wrong user DUZ saved to record
N APPTIEN,CONSULTIEN,COUNT,CREATEDATE,FDA,REQUESTPTR
;
S COUNT=0
S ^XTMP("GMRCP210",COUNT)=$$FMADD^XLFDT(DT,120)_U_DT_U_"COMMENTS EDITED BY GMRC*3.0*210"
;
S CREATEDATE=3240123.999999
F S CREATEDATE=$O(^SDEC(409.84,"AC",CREATEDATE)) Q:'CREATEDATE D
. S APPTIEN=0
. F S APPTIEN=$O(^SDEC(409.84,"AC",CREATEDATE,APPTIEN)) Q:'APPTIEN I $D(^SDEC(409.84,APPTIEN,0)) D
. . ; Only working with Consults
. . S REQUESTPTR=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
. . Q:$P(REQUESTPTR,";",2)'["123"
. . S CONSULTIEN=$P(REQUESTPTR,";")
. . ;
. . Q:'$D(^GMR(123,CONSULTIEN,40))
. . ;
. . N APPTDATA,CANCELDATE,CANCELUSER,CREATEUSER,FDA,NEWUSER,NOSHOWDATE,NOSHOWUSER,SDERRORS
. . D GETS^DIQ(409.84,APPTIEN,".08;.12;.101;.102;.121","I","APPTDATA","SDERRORS")
. . Q:$D(SDERRORS)
. . S CREATEUSER=APPTDATA(409.84,APPTIEN_",",.08,"I")
. . S NOSHOWDATE=APPTDATA(409.84,APPTIEN_",",.101,"I")
. . S NOSHOWUSER=APPTDATA(409.84,APPTIEN_",",.102,"I")
. . S CANCELDATE=APPTDATA(409.84,APPTIEN_",",.12,"I")
. . S CANCELUSER=APPTDATA(409.84,APPTIEN_",",.121,"I")
. . ;
. . ; Check for DUZ mismatches
. . N ACTIVITYDATE,CONACTIEN,CONSULTACTIVITY,CONSULTUSER,FIX
. . S CONACTIEN=0
. . F S CONACTIEN=$O(^GMR(123,CONSULTIEN,40,CONACTIEN)) Q:'CONACTIEN D
. . . S ACTIVITYDATE=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",.01,"I")
. . . S CONSULTUSER=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",4,"I")
. . . S CONSULTACTIVITY=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",1,"E")
. . . ;
. . . ; Check for matching activity dates and mismatched DUZ's
. . . S FIX=0
. . . I CONSULTACTIVITY="SCHEDULED",ACTIVITYDATE=CREATEDATE,CONSULTUSER'=CREATEUSER S NEWUSER=CREATEUSER,FIX=1
. . . I CONSULTACTIVITY="STATUS CHANGE" D
. . . . I ACTIVITYDATE=NOSHOWDATE,CONSULTUSER'=NOSHOWUSER S NEWUSER=NOSHOWUSER,FIX=1 Q
. . . . I ACTIVITYDATE=CANCELDATE,CONSULTUSER'=CANCELUSER S NEWUSER=CANCELUSER,FIX=1
. . . ;
. . . Q:'FIX
. . . ; Fix the mismatching data
. . . S FDA(123.02,CONACTIEN_","_CONSULTIEN_",",4)=NEWUSER
. . . D FILE^DIE(,"FDA") K FDA
. . . ;
. . . ; Store before/after in ^XTMP
. . . S COUNT=COUNT+1
. . . S ^XTMP("GMRCP210",COUNT)="For Consult IEN "_CONSULTIEN_", Action IEN "_CONACTIEN_", the WHO ENTERED ACTIVITY value of "_CONSULTUSER_" has been corrected to "_NEWUSER
;
I 'COUNT S ^XTMP("GMRCP210",1)="No Consult records needed to be corrected at this time."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP210 4157 printed Sep 17, 2026@20:31:21 Page 2
GMRCP210 ;ALB/JAS - GMRC*3.0*210 Post-Init Routine ; 07/29/2026 1:30PM
+1 ;;3.0;CONSULT/REQUEST TRACKING;**210**;DEC 27, 1997;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
TASK ; tasks off process to run the GMRC Consult file clean-up process
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" GMRC*3.0*210 Post-Install to clean-up REQUEST/CONSULTATION (#123) file")
+3 DO MES^XPDUTL(" entries that have the incorrect user DUZ stored in the REQUEST PROCESSING")
+4 DO MES^XPDUTL(" ACTIVITY (#40) sub-file.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+7 SET ZTDESC="GMRC*3.0*210 Post Install Routine Task 1"
+8 SET ZTDTH=$PIECE($HOROLOG,",",1)_","_86399
SET ZTIO=""
SET ZTRTN="REPORT^GMRCP210"
+9 DO ^%ZTLOAD
+10 IF $DATA(ZTSK)
Begin DoDot:1
+11 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+12 DO MES^XPDUTL("")
End DoDot:1
+13 IF '$DATA(ZTSK)
Begin DoDot:1
+14 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+15 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+16 QUIT
+17 ;
REPORT ;
+1 KILL ^XTMP("GMRCP210")
+2 ;
+3 DO CLEANUP
+4 ;
+5 DO MAIL
+6 QUIT
+7 ;
MAIL ;
+1 NEW STANUM,MESS1,PROD,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
+2 SET STANUM=$$KSP^XUPARAM("INST")_","
+3 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+4 SET PROD=$$PROD^XUPROD
+5 SET MESS1="Station: "_STANUM_" - "_" ("_$SELECT(PROD:"PROD",1:"TEST")_") - "
+6 SET XMDUZ=DUZ
+7 SET XMTEXT="^XTMP(""GMRCP210"","
+8 SET XMSUB=MESS1_"GMRC*3.0*210 - Post Install Data Cleanup Report"
+9 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+10 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+11 SET XMY("SWESKY.JEFFREY@DOMAIN.EXT")=""
+12 IF PROD
Begin DoDot:1
+13 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+14 SET XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
End DoDot:1
+15 DO ^XMD
+16 QUIT
+17 ;
CLEANUP ; Data clean-up for file #123 records that have wrong user DUZ saved to record
+1 NEW APPTIEN,CONSULTIEN,COUNT,CREATEDATE,FDA,REQUESTPTR
+2 ;
+3 SET COUNT=0
+4 SET ^XTMP("GMRCP210",COUNT)=$$FMADD^XLFDT(DT,120)_U_DT_U_"COMMENTS EDITED BY GMRC*3.0*210"
+5 ;
+6 SET CREATEDATE=3240123.999999
+7 FOR
SET CREATEDATE=$ORDER(^SDEC(409.84,"AC",CREATEDATE))
if 'CREATEDATE
QUIT
Begin DoDot:1
+8 SET APPTIEN=0
+9 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"AC",CREATEDATE,APPTIEN))
if 'APPTIEN
QUIT
IF $DATA(^SDEC(409.84,APPTIEN,0))
Begin DoDot:2
+10 ; Only working with Consults
+11 SET REQUESTPTR=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
+12 if $PIECE(REQUESTPTR,";",2)'["123"
QUIT
+13 SET CONSULTIEN=$PIECE(REQUESTPTR,";")
+14 ;
+15 if '$DATA(^GMR(123,CONSULTIEN,40))
QUIT
+16 ;
+17 NEW APPTDATA,CANCELDATE,CANCELUSER,CREATEUSER,FDA,NEWUSER,NOSHOWDATE,NOSHOWUSER,SDERRORS
+18 DO GETS^DIQ(409.84,APPTIEN,".08;.12;.101;.102;.121","I","APPTDATA","SDERRORS")
+19 if $DATA(SDERRORS)
QUIT
+20 SET CREATEUSER=APPTDATA(409.84,APPTIEN_",",.08,"I")
+21 SET NOSHOWDATE=APPTDATA(409.84,APPTIEN_",",.101,"I")
+22 SET NOSHOWUSER=APPTDATA(409.84,APPTIEN_",",.102,"I")
+23 SET CANCELDATE=APPTDATA(409.84,APPTIEN_",",.12,"I")
+24 SET CANCELUSER=APPTDATA(409.84,APPTIEN_",",.121,"I")
+25 ;
+26 ; Check for DUZ mismatches
+27 NEW ACTIVITYDATE,CONACTIEN,CONSULTACTIVITY,CONSULTUSER,FIX
+28 SET CONACTIEN=0
+29 FOR
SET CONACTIEN=$ORDER(^GMR(123,CONSULTIEN,40,CONACTIEN))
if 'CONACTIEN
QUIT
Begin DoDot:3
+30 SET ACTIVITYDATE=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",.01,"I")
+31 SET CONSULTUSER=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",4,"I")
+32 SET CONSULTACTIVITY=$$GET1^DIQ(123.02,CONACTIEN_","_CONSULTIEN_",",1,"E")
+33 ;
+34 ; Check for matching activity dates and mismatched DUZ's
+35 SET FIX=0
+36 IF CONSULTACTIVITY="SCHEDULED"
IF ACTIVITYDATE=CREATEDATE
IF CONSULTUSER'=CREATEUSER
SET NEWUSER=CREATEUSER
SET FIX=1
+37 IF CONSULTACTIVITY="STATUS CHANGE"
Begin DoDot:4
+38 IF ACTIVITYDATE=NOSHOWDATE
IF CONSULTUSER'=NOSHOWUSER
SET NEWUSER=NOSHOWUSER
SET FIX=1
QUIT
+39 IF ACTIVITYDATE=CANCELDATE
IF CONSULTUSER'=CANCELUSER
SET NEWUSER=CANCELUSER
SET FIX=1
End DoDot:4
+40 ;
+41 if 'FIX
QUIT
+42 ; Fix the mismatching data
+43 SET FDA(123.02,CONACTIEN_","_CONSULTIEN_",",4)=NEWUSER
+44 DO FILE^DIE(,"FDA")
KILL FDA
+45 ;
+46 ; Store before/after in ^XTMP
+47 SET COUNT=COUNT+1
+48 SET ^XTMP("GMRCP210",COUNT)="For Consult IEN "_CONSULTIEN_", Action IEN "_CONACTIEN_", the WHO ENTERED ACTIVITY value of "_CONSULTUSER_" has been corrected to "_NEWUSER
End DoDot:3
End DoDot:2
End DoDot:1
+49 ;
+50 IF 'COUNT
SET ^XTMP("GMRCP210",1)="No Consult records needed to be corrected at this time."
+51 QUIT
