- RGMTUT01 ;BIR/CML-MPI/PD Compile and Correct Data Validation Data for Local Sites ;08/12/02
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,31,41**;30 Apr 99
- ;
- ;Reference to $$UPDATE^MPIFAPI supported by IA #2706
- ;Reference to VAFCTFU supported by IA #2988
- ;Reference to ^DPT( supported by IA #2070
- ;Reference to ^DGCN(391.91,"APAT" supported by IA #2911
- ;Reference to ^%ZTSCH("TASK" supported by IA #3520
- ;
- EN1 ;Use this entry point to get only display diagnostics for development team
- ;BYPASS=0 means prohibit times are enforced
- ;SITEOPT=0 means CMOR, TF, and diagnostics are included in report
- ;SITEOPT=1 means diagnostics are omitted from report (this is the report for the site)
- ;SITEOPT=2 means only diagnostics are in report
- ;
- S BYPASS=0,SITEOPT=2 G BEGIN
- ;
- EN2 ;Use this entry point from remote query
- S BYPASS=1,SITEOPT=0 G BEGIN ; **41
- ;
- EN3 ;Use this entry point for site menu option [RG NATIONAL ICN STATISTICS] to omit
- ;diagnostic section from report
- S BYPASS=0,SITEOPT=1 G BEGIN
- ;
- BY ;use this call to bypass check to prohibit primetime run
- S BYPASS=1,SITEOPT=2
- ;
- BEGIN ;
- S PRT=0,QFLG=0 K RGROU
- I $D(^XTMP("RGMT","UT01","@@","COMPILE STARTED"))&('$D(^XTMP("RGMT","UT01","@@","COMPILE STOPPED"))) D I QFLG G QUIT
- .;check running tasks to see if compile is running
- .S TASK=0 F S TASK=$O(^%ZTSCH("TASK",TASK)) Q:'TASK D
- ..S RGROU=$P(^%ZTSCH("TASK",TASK),"^",2)
- ..I RGROU="RGMTSTAT" D
- ...I TASK=$G(ZTSK) Q
- ...S QFLG=1
- ...I '$D(RGHLMQ) W !!,"The Stat Report is currently being compiled."
- .I 'QFLG K ^XTMP("RGMT","UT01"),^XTMP("RGMT","REINDDT")
- ;
- I $D(RGHLMQ) G STARTQ
- W !!,"This option provides the following statistics:"
- W !?3,"1. Total patients assigned to each unique COORDINATING MASTER OF"
- W !?3," RECORD (CMOR)."
- W !?3,"2. Total patients shared with each unique entry in the TREATING"
- W !?3," FACILITY LIST (#391.91) file."
- W !?3,"3. Totals for national ICNs, local ICNs, and patients with no ICN."
- I SITEOPT=1 G START
- W !?3,"4. Total CMOR assignments missing a matching Treating Facility."
- W !?3,"5. Total patients with NATIONAL ICN and missing local Treating Facility."
- W !?3,"6. Total number of patients with duplicate entries in the TREATING"
- W !?3," FACILITY LIST file (#391.91)."
- W !?3,"7. Patient File xref problems for ""AICN"", ""AICNL"", and ""SSN""."
- W !?3,"8. Total number of patients with a no ICN but have a CMOR assignment."
- W !?3,"9. Total number of patients with a no ICN but have TF assignments."
- W !?3,"10. Total number of patients with a local ICN but have remote TFs."
- ;
- START ;
- S QFLG=0
- I '$D(^XTMP("RGMT","UT01","@@","COMPILE STARTED")) W !!,"No data is currently available." I SITEOPT=1 G QUIT
- ;
- W !!,"===> NOTE <==="
- I SITEOPT=1 D
- .W !,"This data is compiled by a remote process initiated from the MPI in Austin"
- .W !,"on a regular basis for reporting purposes. It is not compiled by the local"
- .W !,"site, however, the local site can view the last report that was compiled.",!
- ;
- I $D(^XTMP("RGMT","UT01","@@","COMPILE STOPPED")) D G:QFLG QUIT I PRT D ^RGMTUT03 G QUIT
- .S PRT=0
- .S LAST=^XTMP("RGMT","UT01","@@","COMPILE STOPPED")
- .S LAST=$$FMTE^XLFDT(LAST)
- .W !,"This data was last compiled on ",LAST,"."
- .I SITEOPT=1 S PRT=1 Q
- .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you just want a reprint of that data"
- .S DIR("?",1)="Enter:"
- .S DIR("?",2)=" ""YES"" or <RET> to reprint current data and NOT recompile."
- .S DIR("?",3)=" ""NO"" to recompile new data (this may take several hours)."
- .S DIR("?")=" ""^"" to HALT."
- .D ^DIR K DIR
- .I Y="^" S QFLG=1 Q
- .I +Y=1 S PRT=1 Q
- ;
- STARTQ ;pick up here for queued job
- D NOW^%DTC
- ;
- ;check to be sure stat report not being run during prime time
- S TODAY=$$DOW^XLFDT($$NOW^XLFDT()) I TODAY="Saturday"!(TODAY="Sunday") S BYPASS=1
- S QUIT=0
- I 'BYPASS D I QUIT G QUIT
- .S CHKTIME=$E($P(%,".",2),1,4)
- .I CHKTIME>"0700"&(CHKTIME<"1700") S QUIT=1 I '$D(RGHLMQ) D
- ..W !!,"<< STAT report cannot be compiled between 7:00am and 5:00pm! >>"
- ;
- I '$D(RGHLMQ) W !!,"Recompiling data..."
- ;
- S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
- K ^XTMP("RGMT","UT01"),^XTMP("RGMT","REINDDT") ; **41
- S ^XTMP("RGMT","UT01","@@","COMPILE STARTED")=%
- ;
- D REIND^RGMTUT02
- D CMOR,TF,TFCHK
- ;
- I 'PRT D
- .D NOW^%DTC
- .S ^XTMP("RGMT","UT01","@@","COMPILE STOPPED")=%
- D ^RGMTUT03
- ;
- QUIT ;
- K %,BYPASS,CHKTIME,LAST,LOC,PRT,QFLG,QUIT,SITEOPT,TODAY,Y,RGROU,TASK
- Q
- ;
- CMOR ; Check "ACMOR" xref for:
- ; - existence of a TF entry for the CMOR in the TF file #391.91
- ; - existence of a TF for the local site (if not the CMOR)
- ; - CMOR totals by site
- ;
- I '$D(RGHLMQ) D
- .W !!,"Check #1 for:"
- .W !,"- Patients missing Treating Facility entries for their CMOR."
- .W !,"- Patients missing Treating Facility entries for their local site."
- .W !,"- Unique CMOR totals."
- ;
- K ^XTMP("RGMT","UT01","CMOR")
- K ^XTMP("RGMT","UT01","TOT CMOR MISS TF")
- K ^XTMP("RGMT","UT01","TOT LOC SITE MISS TF")
- K ^XTMP("RGMT","UT01","CMOR WITH NO ICN")
- S (CNT,NOICN,TOTMISSC,TOTMISSL)=0
- S SITESTA=$P($$SITE^VASITE(),"^",3),SITEDA=$P($$SITE^VASITE(),"^")
- ;
- S CMOR=0 F S CMOR=$O(^DPT("ACMOR",CMOR)) Q:'CMOR D
- .I '$D(CMOR(CMOR)) S CMOR(CMOR)=0
- .S DFN=0 F S DFN=$O(^DPT("ACMOR",CMOR,DFN)) Q:'DFN D
- ..S CNT=CNT+1 I '$D(RGHLMQ) W:'(CNT#10000) "."
- ..S ICN=$P($G(^DPT(DFN,"MPI")),"^")
- ..I $E(ICN,1,3)=SITESTA Q
- ..I ICN="" D Q
- ...S NOICN=NOICN+1
- ...I '$D(RGHLMQ) W !?3,"DFN #",DFN," has no ICN and a CMOR of ",$P($$NS^XUAF4(CMOR),"^")
- ...S ^XTMP("RGMT","UT01","CMOR WITH NO ICN",DFN)=""
- ...S LOC(991.03)="@" W $$UPDATE^MPIFAPI(DFN,"LOC")
- ..S CMOR(CMOR)=CMOR(CMOR)+1
- ..I '$D(^DGCN(391.91,"APAT",DFN,CMOR)) D
- ...S TOTMISSC=TOTMISSC+1
- ...S SSN=$P($G(^DPT(DFN,0)),"^",9)
- ...S NAME=$P($G(^DPT(DFN,0)),"^")
- ...S ^XTMP("RGMT","UT01","CMOR","ZZMISSC",CMOR,DFN)="DFN/"_DFN_"^NAME/"_NAME_"^SSN/"_SSN_"^ICN/"_ICN
- ...D FILE^VAFCTFU(DFN,CMOR,1)
- ..I SITEDA'=CMOR,'$D(^DGCN(391.91,"APAT",DFN,SITEDA)) D
- ...S TOTMISSL=TOTMISSL+1
- ...S SSN=$P($G(^DPT(DFN,0)),"^",9)
- ...S NAME=$P($G(^DPT(DFN,0)),"^")
- ...S ^XTMP("RGMT","UT01","CMOR","ZZMISSL",CMOR,DFN)="DFN/"_DFN_"^NAME/"_NAME_"^SSN/"_SSN_"^ICN/"_ICN
- ...D FILE^VAFCTFU(DFN,SITEDA,1)
- ;
- S CMOR=0 F S CMOR=$O(CMOR(CMOR)) Q:'CMOR D
- .S CMORNM=$P($$NS^XUAF4(CMOR),"^"),CMORSTA=$P($$NS^XUAF4(CMOR),"^",2) Q:CMORSTA=""
- .S ^XTMP("RGMT","UT01","CMOR",CMORNM,CMORSTA)=CMOR(CMOR)
- S ^XTMP("RGMT","UT01","TOT CMOR MISS TF")=TOTMISSC
- S ^XTMP("RGMT","UT01","TOT LOC SITE MISS TF")=TOTMISSL
- S ^XTMP("RGMT","UT01","CMOR WITH NO ICN")=NOICN
- I '$D(RGHLMQ) W !,"Check #1 - Complete"
- K CMOR,CMORNM,CMORSTA,CNT,DFN,ICN,NAME,NOICN,SITEDA,SITESTA,SSN,TOTMISSC,TOTMISSL
- Q
- ;
- TF ; Get totals for unique sites in the TF file (#391.91)
- I '$D(RGHLMQ) D
- .W !!,"Check #2 for:"
- .W !,"- Unique Treating Facility totals."
- K ^XTMP("RGMT","UT01","TF"),TFCNT S CNT=0
- S SITE=$P($$SITE^VASITE(),"^",3)
- S TF=0 F S TF=$O(^DGCN(391.91,"AINST",TF)) Q:'TF D
- .S CNT=CNT+1 I '$D(RGHLMQ) W:'(CNT#10000) "."
- .I '$D(TFCNT(TF)) S TFCNT(TF)=0
- .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"AINST",TF,TFIEN)) Q:'TFIEN S TFCNT(TF)=TFCNT(TF)+1
- S TF=0 F S TF=$O(TFCNT(TF)) Q:'TF D
- .S TFNM=$P($$NS^XUAF4(TF),"^"),TFSTA=$P($$NS^XUAF4(TF),"^",2) Q:TFSTA=""
- .S ^XTMP("RGMT","UT01","TF",TFNM,TFSTA)=TFCNT(TF)
- I '$D(RGHLMQ) W !,"Check #2 - Complete"
- K CNT,SITE,TF,TFCNT,TFIEN,TFNM,TFSTA
- Q
- ;
- TFCHK ; Get totals for duplicates in TF file (#391.91)
- ;NOICN=# of patients found with remote TFs and no ICN
- ;LOCICN=# of patients found with remote TFs and a local ICN
- ;
- I '$D(RGHLMQ) D
- .W !!,"Check #3 for:"
- .W !,"- Duplicate Treating Facility assignments."
- .W !,"- Patients with Treating Facilities and no ICN."
- .W !,"- Patients remote treating Facilities and Local ICN."
- ;
- K ^XTMP("RGMT","UT01","TOT TFDUP"),^XTMP("RGMT","UT01","TOT NO ICN W/TF"),^XTMP("RGMT","UT01","TOT LOC ICN W/REMOTE TF")
- S (PTCNT,DUPCNT,NOICN,LOCICN)=0
- S SITESTA=$P($$SITE^VASITE(),"^",3),SITEDA=$P($$SITE^VASITE(),"^")
- S DFN=0 F S DFN=$O(^DGCN(391.91,"APAT",DFN)) Q:'DFN D
- .S PTCNT=PTCNT+1 I '$D(RGHLMQ) W:'(PTCNT#10000) "."
- .S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D
- ..S MPI0=$G(^DPT(DFN,"MPI")),ICN=$P(MPI0,"^")
- ..;delete all TFs for patients with no ICN
- ..I ICN="" D Q
- ...S NOICN=NOICN+1
- ...S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,TFIEN)) Q:'TFIEN D
- ....S ^XTMP("RGMT","UT01","NO ICN WITH REMOTE OR LOCAL TF",DFN,TFIEN)=""
- ....D DELETE^VAFCTFU(TFIEN)
- ..;delete all remote TFs for patients with local ICNs
- ..I $E(ICN,1,3)=SITESTA,TF'=SITEDA D Q
- ...S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,TFIEN)) Q:'TFIEN D
- ....S LOCICN=LOCICN+1
- ....S ^XTMP("RGMT","UT01","LOCAL ICN WITH REMOTE TF",DFN,TFIEN)=""
- ....D DELETE^VAFCTFU(TFIEN)
- ..;look for TF dups
- ..S (TFCNT,TFIEN)=0 F S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,TFIEN)) Q:'TFIEN D
- ...S TFCNT=TFCNT+1 I TFCNT>1 D
- ....S DUPCNT=DUPCNT+1
- ....S SSN=$P($G(^DPT(DFN,0)),"^",9)
- ....S NM=$P($G(^(0)),"^")
- ....S ^XTMP("RGMT","UT01","TFDUP",DFN,TFIEN)=TF_"^"_NM_"^"_SSN
- ....D DELETE^VAFCTFU(TFIEN)
- ;
- S ^XTMP("RGMT","UT01","TOT TFDUP")=DUPCNT
- S ^XTMP("RGMT","UT01","TOT NO ICN W/TF")=NOICN
- S ^XTMP("RGMT","UT01","TOT LOC ICN W/REMOTE TF")=LOCICN
- I '$D(RGHLMQ) W !,"Check #3 - Complete"
- K DFN,DUPCNT,ICN,LOCICN,MPI0,NM,NOICN,PTCNT,SITEDA,SITESTA,SSN,TF,TFCNT,TFIEN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTUT01 9558 printed Jan 18, 2025@02:43:43 Page 2
- RGMTUT01 ;BIR/CML-MPI/PD Compile and Correct Data Validation Data for Local Sites ;08/12/02
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,31,41**;30 Apr 99
- +2 ;
- +3 ;Reference to $$UPDATE^MPIFAPI supported by IA #2706
- +4 ;Reference to VAFCTFU supported by IA #2988
- +5 ;Reference to ^DPT( supported by IA #2070
- +6 ;Reference to ^DGCN(391.91,"APAT" supported by IA #2911
- +7 ;Reference to ^%ZTSCH("TASK" supported by IA #3520
- +8 ;
- EN1 ;Use this entry point to get only display diagnostics for development team
- +1 ;BYPASS=0 means prohibit times are enforced
- +2 ;SITEOPT=0 means CMOR, TF, and diagnostics are included in report
- +3 ;SITEOPT=1 means diagnostics are omitted from report (this is the report for the site)
- +4 ;SITEOPT=2 means only diagnostics are in report
- +5 ;
- +6 SET BYPASS=0
- SET SITEOPT=2
- GOTO BEGIN
- +7 ;
- EN2 ;Use this entry point from remote query
- +1 ; **41
- SET BYPASS=1
- SET SITEOPT=0
- GOTO BEGIN
- +2 ;
- EN3 ;Use this entry point for site menu option [RG NATIONAL ICN STATISTICS] to omit
- +1 ;diagnostic section from report
- +2 SET BYPASS=0
- SET SITEOPT=1
- GOTO BEGIN
- +3 ;
- BY ;use this call to bypass check to prohibit primetime run
- +1 SET BYPASS=1
- SET SITEOPT=2
- +2 ;
- BEGIN ;
- +1 SET PRT=0
- SET QFLG=0
- KILL RGROU
- +2 IF $DATA(^XTMP("RGMT","UT01","@@","COMPILE STARTED"))&('$DATA(^XTMP("RGMT","UT01","@@","COMPILE STOPPED")))
- Begin DoDot:1
- +3 ;check running tasks to see if compile is running
- +4 SET TASK=0
- FOR
- SET TASK=$ORDER(^%ZTSCH("TASK",TASK))
- if 'TASK
- QUIT
- Begin DoDot:2
- +5 SET RGROU=$PIECE(^%ZTSCH("TASK",TASK),"^",2)
- +6 IF RGROU="RGMTSTAT"
- Begin DoDot:3
- +7 IF TASK=$GET(ZTSK)
- QUIT
- +8 SET QFLG=1
- +9 IF '$DATA(RGHLMQ)
- WRITE !!,"The Stat Report is currently being compiled."
- End DoDot:3
- End DoDot:2
- +10 IF 'QFLG
- KILL ^XTMP("RGMT","UT01"),^XTMP("RGMT","REINDDT")
- End DoDot:1
- IF QFLG
- GOTO QUIT
- +11 ;
- +12 IF $DATA(RGHLMQ)
- GOTO STARTQ
- +13 WRITE !!,"This option provides the following statistics:"
- +14 WRITE !?3,"1. Total patients assigned to each unique COORDINATING MASTER OF"
- +15 WRITE !?3," RECORD (CMOR)."
- +16 WRITE !?3,"2. Total patients shared with each unique entry in the TREATING"
- +17 WRITE !?3," FACILITY LIST (#391.91) file."
- +18 WRITE !?3,"3. Totals for national ICNs, local ICNs, and patients with no ICN."
- +19 IF SITEOPT=1
- GOTO START
- +20 WRITE !?3,"4. Total CMOR assignments missing a matching Treating Facility."
- +21 WRITE !?3,"5. Total patients with NATIONAL ICN and missing local Treating Facility."
- +22 WRITE !?3,"6. Total number of patients with duplicate entries in the TREATING"
- +23 WRITE !?3," FACILITY LIST file (#391.91)."
- +24 WRITE !?3,"7. Patient File xref problems for ""AICN"", ""AICNL"", and ""SSN""."
- +25 WRITE !?3,"8. Total number of patients with a no ICN but have a CMOR assignment."
- +26 WRITE !?3,"9. Total number of patients with a no ICN but have TF assignments."
- +27 WRITE !?3,"10. Total number of patients with a local ICN but have remote TFs."
- +28 ;
- START ;
- +1 SET QFLG=0
- +2 IF '$DATA(^XTMP("RGMT","UT01","@@","COMPILE STARTED"))
- WRITE !!,"No data is currently available."
- IF SITEOPT=1
- GOTO QUIT
- +3 ;
- +4 WRITE !!,"===> NOTE <==="
- +5 IF SITEOPT=1
- Begin DoDot:1
- +6 WRITE !,"This data is compiled by a remote process initiated from the MPI in Austin"
- +7 WRITE !,"on a regular basis for reporting purposes. It is not compiled by the local"
- +8 WRITE !,"site, however, the local site can view the last report that was compiled.",!
- End DoDot:1
- +9 ;
- +10 IF $DATA(^XTMP("RGMT","UT01","@@","COMPILE STOPPED"))
- Begin DoDot:1
- +11 SET PRT=0
- +12 SET LAST=^XTMP("RGMT","UT01","@@","COMPILE STOPPED")
- +13 SET LAST=$$FMTE^XLFDT(LAST)
- +14 WRITE !,"This data was last compiled on ",LAST,"."
- +15 IF SITEOPT=1
- SET PRT=1
- QUIT
- +16 SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="Do you just want a reprint of that data"
- +17 SET DIR("?",1)="Enter:"
- +18 SET DIR("?",2)=" ""YES"" or <RET> to reprint current data and NOT recompile."
- +19 SET DIR("?",3)=" ""NO"" to recompile new data (this may take several hours)."
- +20 SET DIR("?")=" ""^"" to HALT."
- +21 DO ^DIR
- KILL DIR
- +22 IF Y="^"
- SET QFLG=1
- QUIT
- +23 IF +Y=1
- SET PRT=1
- QUIT
- End DoDot:1
- if QFLG
- GOTO QUIT
- IF PRT
- DO ^RGMTUT03
- GOTO QUIT
- +24 ;
- STARTQ ;pick up here for queued job
- +1 DO NOW^%DTC
- +2 ;
- +3 ;check to be sure stat report not being run during prime time
- +4 SET TODAY=$$DOW^XLFDT($$NOW^XLFDT())
- IF TODAY="Saturday"!(TODAY="Sunday")
- SET BYPASS=1
- +5 SET QUIT=0
- +6 IF 'BYPASS
- Begin DoDot:1
- +7 SET CHKTIME=$EXTRACT($PIECE(%,".",2),1,4)
- +8 IF CHKTIME>"0700"&(CHKTIME<"1700")
- SET QUIT=1
- IF '$DATA(RGHLMQ)
- Begin DoDot:2
- +9 WRITE !!,"<< STAT report cannot be compiled between 7:00am and 5:00pm! >>"
- End DoDot:2
- End DoDot:1
- IF QUIT
- GOTO QUIT
- +10 ;
- +11 IF '$DATA(RGHLMQ)
- WRITE !!,"Recompiling data..."
- +12 ;
- +13 SET ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
- +14 ; **41
- KILL ^XTMP("RGMT","UT01"),^XTMP("RGMT","REINDDT")
- +15 SET ^XTMP("RGMT","UT01","@@","COMPILE STARTED")=%
- +16 ;
- +17 DO REIND^RGMTUT02
- +18 DO CMOR
- DO TF
- DO TFCHK
- +19 ;
- +20 IF 'PRT
- Begin DoDot:1
- +21 DO NOW^%DTC
- +22 SET ^XTMP("RGMT","UT01","@@","COMPILE STOPPED")=%
- End DoDot:1
- +23 DO ^RGMTUT03
- +24 ;
- QUIT ;
- +1 KILL %,BYPASS,CHKTIME,LAST,LOC,PRT,QFLG,QUIT,SITEOPT,TODAY,Y,RGROU,TASK
- +2 QUIT
- +3 ;
- CMOR ; Check "ACMOR" xref for:
- +1 ; - existence of a TF entry for the CMOR in the TF file #391.91
- +2 ; - existence of a TF for the local site (if not the CMOR)
- +3 ; - CMOR totals by site
- +4 ;
- +5 IF '$DATA(RGHLMQ)
- Begin DoDot:1
- +6 WRITE !!,"Check #1 for:"
- +7 WRITE !,"- Patients missing Treating Facility entries for their CMOR."
- +8 WRITE !,"- Patients missing Treating Facility entries for their local site."
- +9 WRITE !,"- Unique CMOR totals."
- End DoDot:1
- +10 ;
- +11 KILL ^XTMP("RGMT","UT01","CMOR")
- +12 KILL ^XTMP("RGMT","UT01","TOT CMOR MISS TF")
- +13 KILL ^XTMP("RGMT","UT01","TOT LOC SITE MISS TF")
- +14 KILL ^XTMP("RGMT","UT01","CMOR WITH NO ICN")
- +15 SET (CNT,NOICN,TOTMISSC,TOTMISSL)=0
- +16 SET SITESTA=$PIECE($$SITE^VASITE(),"^",3)
- SET SITEDA=$PIECE($$SITE^VASITE(),"^")
- +17 ;
- +18 SET CMOR=0
- FOR
- SET CMOR=$ORDER(^DPT("ACMOR",CMOR))
- if 'CMOR
- QUIT
- Begin DoDot:1
- +19 IF '$DATA(CMOR(CMOR))
- SET CMOR(CMOR)=0
- +20 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("ACMOR",CMOR,DFN))
- if 'DFN
- QUIT
- Begin DoDot:2
- +21 SET CNT=CNT+1
- IF '$DATA(RGHLMQ)
- if '(CNT#10000)
- WRITE "."
- +22 SET ICN=$PIECE($GET(^DPT(DFN,"MPI")),"^")
- +23 IF $EXTRACT(ICN,1,3)=SITESTA
- QUIT
- +24 IF ICN=""
- Begin DoDot:3
- +25 SET NOICN=NOICN+1
- +26 IF '$DATA(RGHLMQ)
- WRITE !?3,"DFN #",DFN," has no ICN and a CMOR of ",$PIECE($$NS^XUAF4(CMOR),"^")
- +27 SET ^XTMP("RGMT","UT01","CMOR WITH NO ICN",DFN)=""
- +28 SET LOC(991.03)="@"
- WRITE $$UPDATE^MPIFAPI(DFN,"LOC")
- End DoDot:3
- QUIT
- +29 SET CMOR(CMOR)=CMOR(CMOR)+1
- +30 IF '$DATA(^DGCN(391.91,"APAT",DFN,CMOR))
- Begin DoDot:3
- +31 SET TOTMISSC=TOTMISSC+1
- +32 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
- +33 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
- +34 SET ^XTMP("RGMT","UT01","CMOR","ZZMISSC",CMOR,DFN)="DFN/"_DFN_"^NAME/"_NAME_"^SSN/"_SSN_"^ICN/"_ICN
- +35 DO FILE^VAFCTFU(DFN,CMOR,1)
- End DoDot:3
- +36 IF SITEDA'=CMOR
- IF '$DATA(^DGCN(391.91,"APAT",DFN,SITEDA))
- Begin DoDot:3
- +37 SET TOTMISSL=TOTMISSL+1
- +38 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
- +39 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
- +40 SET ^XTMP("RGMT","UT01","CMOR","ZZMISSL",CMOR,DFN)="DFN/"_DFN_"^NAME/"_NAME_"^SSN/"_SSN_"^ICN/"_ICN
- +41 DO FILE^VAFCTFU(DFN,SITEDA,1)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 ;
- +43 SET CMOR=0
- FOR
- SET CMOR=$ORDER(CMOR(CMOR))
- if 'CMOR
- QUIT
- Begin DoDot:1
- +44 SET CMORNM=$PIECE($$NS^XUAF4(CMOR),"^")
- SET CMORSTA=$PIECE($$NS^XUAF4(CMOR),"^",2)
- if CMORSTA=""
- QUIT
- +45 SET ^XTMP("RGMT","UT01","CMOR",CMORNM,CMORSTA)=CMOR(CMOR)
- End DoDot:1
- +46 SET ^XTMP("RGMT","UT01","TOT CMOR MISS TF")=TOTMISSC
- +47 SET ^XTMP("RGMT","UT01","TOT LOC SITE MISS TF")=TOTMISSL
- +48 SET ^XTMP("RGMT","UT01","CMOR WITH NO ICN")=NOICN
- +49 IF '$DATA(RGHLMQ)
- WRITE !,"Check #1 - Complete"
- +50 KILL CMOR,CMORNM,CMORSTA,CNT,DFN,ICN,NAME,NOICN,SITEDA,SITESTA,SSN,TOTMISSC,TOTMISSL
- +51 QUIT
- +52 ;
- TF ; Get totals for unique sites in the TF file (#391.91)
- +1 IF '$DATA(RGHLMQ)
- Begin DoDot:1
- +2 WRITE !!,"Check #2 for:"
- +3 WRITE !,"- Unique Treating Facility totals."
- End DoDot:1
- +4 KILL ^XTMP("RGMT","UT01","TF"),TFCNT
- SET CNT=0
- +5 SET SITE=$PIECE($$SITE^VASITE(),"^",3)
- +6 SET TF=0
- FOR
- SET TF=$ORDER(^DGCN(391.91,"AINST",TF))
- if 'TF
- QUIT
- Begin DoDot:1
- +7 SET CNT=CNT+1
- IF '$DATA(RGHLMQ)
- if '(CNT#10000)
- WRITE "."
- +8 IF '$DATA(TFCNT(TF))
- SET TFCNT(TF)=0
- +9 SET TFIEN=0
- FOR
- SET TFIEN=$ORDER(^DGCN(391.91,"AINST",TF,TFIEN))
- if 'TFIEN
- QUIT
- SET TFCNT(TF)=TFCNT(TF)+1
- End DoDot:1
- +10 SET TF=0
- FOR
- SET TF=$ORDER(TFCNT(TF))
- if 'TF
- QUIT
- Begin DoDot:1
- +11 SET TFNM=$PIECE($$NS^XUAF4(TF),"^")
- SET TFSTA=$PIECE($$NS^XUAF4(TF),"^",2)
- if TFSTA=""
- QUIT
- +12 SET ^XTMP("RGMT","UT01","TF",TFNM,TFSTA)=TFCNT(TF)
- End DoDot:1
- +13 IF '$DATA(RGHLMQ)
- WRITE !,"Check #2 - Complete"
- +14 KILL CNT,SITE,TF,TFCNT,TFIEN,TFNM,TFSTA
- +15 QUIT
- +16 ;
- TFCHK ; Get totals for duplicates in TF file (#391.91)
- +1 ;NOICN=# of patients found with remote TFs and no ICN
- +2 ;LOCICN=# of patients found with remote TFs and a local ICN
- +3 ;
- +4 IF '$DATA(RGHLMQ)
- Begin DoDot:1
- +5 WRITE !!,"Check #3 for:"
- +6 WRITE !,"- Duplicate Treating Facility assignments."
- +7 WRITE !,"- Patients with Treating Facilities and no ICN."
- +8 WRITE !,"- Patients remote treating Facilities and Local ICN."
- End DoDot:1
- +9 ;
- +10 KILL ^XTMP("RGMT","UT01","TOT TFDUP"),^XTMP("RGMT","UT01","TOT NO ICN W/TF"),^XTMP("RGMT","UT01","TOT LOC ICN W/REMOTE TF")
- +11 SET (PTCNT,DUPCNT,NOICN,LOCICN)=0
- +12 SET SITESTA=$PIECE($$SITE^VASITE(),"^",3)
- SET SITEDA=$PIECE($$SITE^VASITE(),"^")
- +13 SET DFN=0
- FOR
- SET DFN=$ORDER(^DGCN(391.91,"APAT",DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +14 SET PTCNT=PTCNT+1
- IF '$DATA(RGHLMQ)
- if '(PTCNT#10000)
- WRITE "."
- +15 SET TF=0
- FOR
- SET TF=$ORDER(^DGCN(391.91,"APAT",DFN,TF))
- if 'TF
- QUIT
- Begin DoDot:2
- +16 SET MPI0=$GET(^DPT(DFN,"MPI"))
- SET ICN=$PIECE(MPI0,"^")
- +17 ;delete all TFs for patients with no ICN
- +18 IF ICN=""
- Begin DoDot:3
- +19 SET NOICN=NOICN+1
- +20 SET TFIEN=0
- FOR
- SET TFIEN=$ORDER(^DGCN(391.91,"APAT",DFN,TF,TFIEN))
- if 'TFIEN
- QUIT
- Begin DoDot:4
- +21 SET ^XTMP("RGMT","UT01","NO ICN WITH REMOTE OR LOCAL TF",DFN,TFIEN)=""
- +22 DO DELETE^VAFCTFU(TFIEN)
- End DoDot:4
- End DoDot:3
- QUIT
- +23 ;delete all remote TFs for patients with local ICNs
- +24 IF $EXTRACT(ICN,1,3)=SITESTA
- IF TF'=SITEDA
- Begin DoDot:3
- +25 SET TFIEN=0
- FOR
- SET TFIEN=$ORDER(^DGCN(391.91,"APAT",DFN,TF,TFIEN))
- if 'TFIEN
- QUIT
- Begin DoDot:4
- +26 SET LOCICN=LOCICN+1
- +27 SET ^XTMP("RGMT","UT01","LOCAL ICN WITH REMOTE TF",DFN,TFIEN)=""
- +28 DO DELETE^VAFCTFU(TFIEN)
- End DoDot:4
- End DoDot:3
- QUIT
- +29 ;look for TF dups
- +30 SET (TFCNT,TFIEN)=0
- FOR
- SET TFIEN=$ORDER(^DGCN(391.91,"APAT",DFN,TF,TFIEN))
- if 'TFIEN
- QUIT
- Begin DoDot:3
- +31 SET TFCNT=TFCNT+1
- IF TFCNT>1
- Begin DoDot:4
- +32 SET DUPCNT=DUPCNT+1
- +33 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
- +34 SET NM=$PIECE($GET(^(0)),"^")
- +35 SET ^XTMP("RGMT","UT01","TFDUP",DFN,TFIEN)=TF_"^"_NM_"^"_SSN
- +36 DO DELETE^VAFCTFU(TFIEN)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 ;
- +38 SET ^XTMP("RGMT","UT01","TOT TFDUP")=DUPCNT
- +39 SET ^XTMP("RGMT","UT01","TOT NO ICN W/TF")=NOICN
- +40 SET ^XTMP("RGMT","UT01","TOT LOC ICN W/REMOTE TF")=LOCICN
- +41 IF '$DATA(RGHLMQ)
- WRITE !,"Check #3 - Complete"
- +42 KILL DFN,DUPCNT,ICN,LOCICN,MPI0,NM,NOICN,PTCNT,SITEDA,SITESTA,SSN,TF,TFCNT,TFIEN
- +43 QUIT