SD53120A ;ALB/REV; Scheduling/PCE Bad Pointer Count ;5/15/97
;;5.3;Scheduling;**120**;Aug 13, 1993
;
EN ;This is the entry point to start the count of problems
;in the outpatient encounter file. This entry point allows
;for date selection and queuing
;
N BEGDATE,ENDDATE,ZTDESC,ZTIO,ZTRTN,A,X,Y
;
;if NOT run as post-install, clear SDMNT and prompt for dates
I '$D(XPDNM) D
.S SDMNT=""
.D DATE^SDUTL
;if run as post-install, set SDMNT and stuff dates
E D
.S SDMNT="G.AMB CARE DEVELOPERS@ISC-ALBANY.DOMAIN.EXT"
.S BEGDATE=2961001,ENDDATE=2970331
I '$D(BEGDATE)!('$D(ENDDATE)) G ENQ
I BEGDATE<2961001 W !,"Can not select a date before 10/1/96." G EN
;
S ZTRTN="TSK^SD53120A",ZTDESC="Scheduling/PCE Error Count",ZTIO=""
F A="BEGDATE","ENDDATE","DUZ","SDMNT" S ZTSAVE(A)=""
I '$D(XPDNM) G:'$$OK() ENQ
I $D(XPDNM) S X=DT_".23" D H^%DTC S ZTDTH=%H_","_%T
D ^%ZTLOAD
S Y=X D DD^%DT
I $D(ZTSK) D BMES^XPDUTL("Job queued to run "_Y_", task number "_ZTSK)
I '$D(ZTSK) D BMES^XPDUTL("Job not queued!")
;
ENQ K ZTSAVE,SDBD,SDED,POP,ZTSK,ZTRTN,ZTDTH,%H,%T
Q
;
TSK ; entry point for the queued task
;BEGDATE the date of the encounter this job is to start working at.
;ENDDATE the date of the encounter this job is to stop at.
;DUZ the duz of the user who started the job.
;SDMNT is this the post-install or via menu option?
;
N SDPDATE,SDTEXT,SDPZTSK
S SDPZTSK=ZTSK
S SDPDATE=BEGDATE-.0000001
I '$P(ENDDATE,".",2) S ENDDATE=ENDDATE+".235959"
S SDTEXT="^TMP($J)"
D FINDERR
D MAILMSG(DUZ,SDMNT,SDTEXT)
S:($D(ZTQUEUED)) ZTREQ="@"
TSKQ Q
;
MAILMSG(USER,SDMNT,XMTEXT) ;this subroutine will fire a message when
; the background job has finished.
; USER - who started the job
; SDMNT - To Albany CIOFO if run as post-install
; XMTEXT - notes for the end of the message
;
N Y,SAV
S XMDUZ=.5
I $G(SDMNT)'="" S XMY(SDMNT)=""
I $D(USER) S XMY(USER)=""
S XMSUB="Scheduling/PCE Encounter Error Count"
S SAV=XMTEXT
S XMTEXT=$TR(XMTEXT,")",",")
D ^XMD
S XMTEXT=SAV
K @XMTEXT,XMZ,XMY,XMDUZ,XMSUB,SDMNT
MAILQ Q
;
OK() ;last chance to back out
N Y,DIR,X
S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO"
D ^DIR
Q $S(+Y<1:0,1:1)
;
BLDTXT(CTR,TEXT,SDTEXT) ; create line of text
S CTR=+CTR+1
S @SDTEXT@(CTR)=TEXT
Q
;
FINDERR ; main program block
N SDMISA,SDBADA,SDTOTA,SDDFN,SDAPPT,SDAP,SDCLIN,SDENC,SCDATE,SCDFN
N SDMISD,SDBADD,SDTOTD,SCDUPEA,SCDUPED,SCTOTE,SCDUPEE,SCDUPEC
N SCSTOP,SDSTOP,SDDI,SDDISP,SDDATE,SCAPAT,SCADAT,SCASTP,SCDPAT,SCDDAT
N SDPAT,SCADT,SCDDT,SDANE,SDANP,SDANA,SDDNE,SDDNP,SDDND,ZTSTOP
S (SDMISA,SDBADA,SDTOTA,SDMISD,SDBADD,SDTOTD,SDDFN,SCDUPEA,SCDUPEE)=0
S (SCDUPED,SDPAT,SCDUPEC,SCTOTE,SCAPAT,SCADAT,SCASTP,SCDPAT,SCDDAT)=0
S (SCADT,SCDDT,SDANE,SDANP,SDANA,SDDNE,SDDNP,SDDND,ZTSTOP)=0
F SDPAT=1:1 S SDDFN=$O(^DPT(+SDDFN)) Q:+SDDFN=0 D Q:ZTSTOP
.S ZTSTOP=$$S^%ZTLOAD
.D APPT
.D DISP
I ZTSTOP D OUTPUT Q
D DUP
D OUTPUT
Q
OUTPUT ; create text for MailMan message
N SDLINE,Y
S CTR=$O(@SDTEXT@(99999999),-1)
S SDLINE="",$P(SDLINE,"-",78)=""
S Y=$$SITE^VASITE()
D BLDTXT(.CTR," Reporting Site: "_$P(Y,"^",2)_" ("_$P(Y,"^",3)_")",SDTEXT)
D BLDTXT(.CTR," Number of patients: "_SDPAT,SDTEXT)
S BEGDATE=$$FMTE^XLFDT(BEGDATE)
S ENDDATE=$$FMTE^XLFDT($P(ENDDATE,".",1))
D BLDTXT(.CTR,"Encounter Start Date: "_BEGDATE,SDTEXT)
D BLDTXT(.CTR," Encounter End Date: "_ENDDATE,SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
I ZTSTOP D BLDTXT(.CTR,"*** Task halted at user request ***",SDTEXT)
D BLDTXT(.CTR,SDLINE,SDTEXT)
D BLDTXT(.CTR,"PATIENT APPOINTMENT MULTIPLE vs. OUTPATIENT ENCOUNTER FILE:",SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,"Appointment does not point to an encounter: "_SDANE,SDTEXT)
D BLDTXT(.CTR," Pointed-to encounter is missing: "_SDMISA,SDTEXT)
D BLDTXT(.CTR,"Pointed-to encounter has inconsistent data: "_SDBADA,SDTEXT)
D BLDTXT(.CTR," Not a parent: "_SDANP,SDTEXT)
D BLDTXT(.CTR," Not an appointment: "_SDANA,SDTEXT)
D BLDTXT(.CTR," Patient: "_SCAPAT,SDTEXT)
D BLDTXT(.CTR," Date: "_SCADAT,SDTEXT)
D BLDTXT(.CTR," Time: "_SCADT,SDTEXT)
D BLDTXT(.CTR," Stop code: "_SCASTP,SDTEXT)
D BLDTXT(.CTR," ",.SDTEXT)
D BLDTXT(.CTR,SDMISA+SDBADA+SDANE_" total errors out of "_SDTOTA_" appointment records.",SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,"NOTE: The stop code from the PATIENT file Appointment multiple was compared",SDTEXT)
D BLDTXT(.CTR,"against the stop code in the pointed-to encounter, and non-matches",SDTEXT)
D BLDTXT(.CTR,"were counted. Because stop codes are being added and deactivated over time,",SDTEXT)
D BLDTXT(.CTR,"a true comparison of the stop code of the clinic with the stop code of the",SDTEXT)
D BLDTXT(.CTR,"appointment/encounter is probably impossible without human review.",SDTEXT)
D BLDTXT(.CTR,SDLINE,SDTEXT)
D BLDTXT(.CTR,"PATIENT DISPOSITION MULTIPLE vs. OUTPATIENT ENCOUNTER FILE:",SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,"Disposition does not point to an encounter: "_SDDNE,SDTEXT)
D BLDTXT(.CTR," Pointed-to encounter is missing: "_SDMISD,SDTEXT)
D BLDTXT(.CTR,"Pointed-to encounter has inconsistent data: "_SDBADD,SDTEXT)
D BLDTXT(.CTR," Not a parent: "_SDDNP,SDTEXT)
D BLDTXT(.CTR," Not a disposition: "_SDDND,SDTEXT)
D BLDTXT(.CTR," Patient: "_SCDPAT,SDTEXT)
D BLDTXT(.CTR," Date: "_SCDDAT,SDTEXT)
D BLDTXT(.CTR," Time: "_SCDDT,SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,SDMISD+SDBADD+SDDNE_" total errors out of "_SDTOTD_" disposition records.",SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,SDLINE,SDTEXT)
D BLDTXT(.CTR,"POSSIBLY DUPLICATE ENCOUNTERS: ",SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,"Duplicate appointment encounters: "_SCDUPEA,SDTEXT)
D BLDTXT(.CTR," Duplicate add/edit encounters: "_SCDUPEE,SDTEXT)
D BLDTXT(.CTR,"Duplicate disposition encounters: "_SCDUPED,SDTEXT)
D BLDTXT(.CTR,"Duplicate credit stop encounters: "_SCDUPEC,SDTEXT)
D BLDTXT(.CTR," ",SDTEXT)
D BLDTXT(.CTR,SCDUPEA+SCDUPEE+SCDUPED+SCDUPEC_" total errors out of "_SCTOTE_" encounter records.",SDTEXT)
Q
APPT ; check patient appointment multiple
N SDOE
S SDAPPT=SDPDATE
F S SDAPPT=$O(^DPT(SDDFN,"S",SDAPPT)) Q:('SDAPPT)!(SDAPPT>ENDDATE) D
.S SDTOTA=SDTOTA+1
.S SDAP=$G(^DPT(SDDFN,"S",SDAPPT,0)) Q:'SDAP
.S SDCLIN=$P(SDAP,"^",1),SDSTOP=$P(^SC(SDCLIN,0),"^",7)
.S SDENC=$P(SDAP,"^",20)
.I 'SDENC S:($P(SDAP,"^",2)="NT") SDANE=SDANE+1 Q
.I '$D(^SCE(SDENC)) S SDMISA=SDMISA+1 Q
.S SDOE=$G(^SCE(SDENC,0))
.I $P(SDOE,"^",6) S SDANP=SDANP+1,SDBADA=SDBADA+1 Q ;not a parent encounter
.I $P(SDOE,"^",8)'=1 S SDANA=SDANA+1,SDBADA=SDBADA+1 Q ;not an appointment
.S SCDATE=$P(SDOE,"^",1)
.S SCDFN=$P(SDOE,"^",2)
.S SCSTOP=$P(SDOE,"^",3)
.I SDDFN'=SCDFN S SCAPAT=SCAPAT+1,SDBADA=SDBADA+1 Q
.I $P(SCDATE,".",1)'=$P(SDAPPT,".",1) S SCADAT=SCADAT+1,SDBADA=SDBADA+1 Q
.I $P(SCDATE,".",2)'=$P(SDAPPT,".",2) S SCADT=SCADT+1,SDBADA=SDBADA+1 Q
.I SCSTOP'=SDSTOP S SCASTP=SCASTP+1,SDBADA=SDBADA+1 Q
Q
DISP ; check patient disposition multiple
N SDOE
S SDDISP=9999999-ENDDATE
F S SDDISP=$O(^DPT(SDDFN,"DIS",SDDISP)) Q:('SDDISP)!((9999999-SDDISP)<SDPDATE) D
.S SDTOTD=SDTOTD+1
.S SDDI=$G(^DPT(SDDFN,"DIS",SDDISP,0)) Q:'SDDI
.I $P(SDDI,"^",2)=2 Q
.S SDENC=$P(SDDI,"^",18)
.I 'SDENC S:(+$P(SDDI,"^",6)) SDDNE=SDDNE+1 Q
.I '$D(^SCE(SDENC)) S SDMISD=SDMISD+1 Q
.S SDOE=$G(^SCE(SDENC,0))
.I $P(SDOE,"^",6) S SDDNP=SDDNP+1,SDBADD=SDBADD+1 Q ;not a parent encounter
.I $P(SDOE,"^",8)'=3 S SDDND=SDDND+1,SDBADD=SDBADD+1 Q ;not a disposition
.S SDDATE=$P(SDDI,"^",1)
.S SCDATE=$P(SDOE,"^",1)
.S SCDFN=$P(SDOE,"^",2)
.I SDDFN'=SCDFN S SCDPAT=SCDPAT+1,SDBADD=SDBADD+1 Q
.I $P(SCDATE,".",1)'=$P(SDDATE,".",1) S SCDDAT=SCDDAT+1,SDBADD=SDBADD+1 Q
.I $P(SCDATE,".",2)'=$P(SDDATE,".",2) S SCDDT=SCDDT+1,SDBADD=SDBADD+1 Q
Q
DUP ; loop through outpatient encounter file - call DUPCHECK
N SCDFN,SCDT,SCENC,SCREC1,SCREC2,SCNUM1,SCNUM2
S (SCDFN,SCDT,SCREC1,SCREC2,SCNUM1,SCNUM2,SCENC)=""
F S SCDFN=$O(^SCE("ADFN",SCDFN)) Q:'SCDFN D Q:ZTSTOP
.S ZTSTOP=$$S^%ZTLOAD
.S SCDT=SDPDATE
.F S SCDT=$O(^SCE("ADFN",SCDFN,SCDT)) Q:('SCDT)!(SCDT>ENDDATE) D
..S SCENC=""
..F S SCENC=$O(^SCE("ADFN",SCDFN,SCDT,SCENC)) Q:'SCENC D DUPCHECK
Q
DUPCHECK ; check for duplicates
S SCTOTE=SCTOTE+1
S SCNUM1=SCENC,SCREC1=$G(^SCE(+SCENC,0)) Q:'SCREC1
S SCNUM2=$O(^SCE("ADFN",SCDFN,SCDT,SCNUM1)) Q:SCNUM2=""
S SCREC2=$G(^SCE(+SCNUM2,0)) Q:'SCREC2
Q:$P(SCREC1,"^",6)!($P(SCREC2,"^",6)) ;not a parent encounter
Q:$P(SCREC2,"^",1,3)'=$P(SCREC1,"^",1,3) ;not same date/patient/stop
Q:$P(SCREC2,"^",5)'=$P(SCREC1,"^",5) ;not same Visit ID
Q:$P(SCREC2,"^",8)'=$P(SCREC1,"^",8) ;not same Orig Proc
I $P(SCREC1,"^",8)=1 S SCDUPEA=SCDUPEA+1 Q
I $P(SCREC1,"^",8)=2 S SCDUPEE=SCDUPEE+1 Q
I $P(SCREC1,"^",8)=3 S SCDUPED=SCDUPED+1 Q
I $P(SCREC1,"^",8)=4 S SCDUPEC=SCDUPEC+1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53120A 9309 printed Oct 16, 2024@18:45:26 Page 2
SD53120A ;ALB/REV; Scheduling/PCE Bad Pointer Count ;5/15/97
+1 ;;5.3;Scheduling;**120**;Aug 13, 1993
+2 ;
EN ;This is the entry point to start the count of problems
+1 ;in the outpatient encounter file. This entry point allows
+2 ;for date selection and queuing
+3 ;
+4 NEW BEGDATE,ENDDATE,ZTDESC,ZTIO,ZTRTN,A,X,Y
+5 ;
+6 ;if NOT run as post-install, clear SDMNT and prompt for dates
+7 IF '$DATA(XPDNM)
Begin DoDot:1
+8 SET SDMNT=""
+9 DO DATE^SDUTL
End DoDot:1
+10 ;if run as post-install, set SDMNT and stuff dates
+11 IF '$TEST
Begin DoDot:1
+12 SET SDMNT="G.AMB CARE DEVELOPERS@ISC-ALBANY.DOMAIN.EXT"
+13 SET BEGDATE=2961001
SET ENDDATE=2970331
End DoDot:1
+14 IF '$DATA(BEGDATE)!('$DATA(ENDDATE))
GOTO ENQ
+15 IF BEGDATE<2961001
WRITE !,"Can not select a date before 10/1/96."
GOTO EN
+16 ;
+17 SET ZTRTN="TSK^SD53120A"
SET ZTDESC="Scheduling/PCE Error Count"
SET ZTIO=""
+18 FOR A="BEGDATE","ENDDATE","DUZ","SDMNT"
SET ZTSAVE(A)=""
+19 IF '$DATA(XPDNM)
if '$$OK()
GOTO ENQ
+20 IF $DATA(XPDNM)
SET X=DT_".23"
DO H^%DTC
SET ZTDTH=%H_","_%T
+21 DO ^%ZTLOAD
+22 SET Y=X
DO DD^%DT
+23 IF $DATA(ZTSK)
DO BMES^XPDUTL("Job queued to run "_Y_", task number "_ZTSK)
+24 IF '$DATA(ZTSK)
DO BMES^XPDUTL("Job not queued!")
+25 ;
ENQ KILL ZTSAVE,SDBD,SDED,POP,ZTSK,ZTRTN,ZTDTH,%H,%T
+1 QUIT
+2 ;
TSK ; entry point for the queued task
+1 ;BEGDATE the date of the encounter this job is to start working at.
+2 ;ENDDATE the date of the encounter this job is to stop at.
+3 ;DUZ the duz of the user who started the job.
+4 ;SDMNT is this the post-install or via menu option?
+5 ;
+6 NEW SDPDATE,SDTEXT,SDPZTSK
+7 SET SDPZTSK=ZTSK
+8 SET SDPDATE=BEGDATE-.0000001
+9 IF '$PIECE(ENDDATE,".",2)
SET ENDDATE=ENDDATE+".235959"
+10 SET SDTEXT="^TMP($J)"
+11 DO FINDERR
+12 DO MAILMSG(DUZ,SDMNT,SDTEXT)
+13 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
TSKQ QUIT
+1 ;
MAILMSG(USER,SDMNT,XMTEXT) ;this subroutine will fire a message when
+1 ; the background job has finished.
+2 ; USER - who started the job
+3 ; SDMNT - To Albany CIOFO if run as post-install
+4 ; XMTEXT - notes for the end of the message
+5 ;
+6 NEW Y,SAV
+7 SET XMDUZ=.5
+8 IF $GET(SDMNT)'=""
SET XMY(SDMNT)=""
+9 IF $DATA(USER)
SET XMY(USER)=""
+10 SET XMSUB="Scheduling/PCE Encounter Error Count"
+11 SET SAV=XMTEXT
+12 SET XMTEXT=$TRANSLATE(XMTEXT,")",",")
+13 DO ^XMD
+14 SET XMTEXT=SAV
+15 KILL @XMTEXT,XMZ,XMY,XMDUZ,XMSUB,SDMNT
MAILQ QUIT
+1 ;
OK() ;last chance to back out
+1 NEW Y,DIR,X
+2 SET DIR(0)="Y"
SET DIR("A")="OK to continue"
SET DIR("B")="NO"
+3 DO ^DIR
+4 QUIT $SELECT(+Y<1:0,1:1)
+5 ;
BLDTXT(CTR,TEXT,SDTEXT) ; create line of text
+1 SET CTR=+CTR+1
+2 SET @SDTEXT@(CTR)=TEXT
+3 QUIT
+4 ;
FINDERR ; main program block
+1 NEW SDMISA,SDBADA,SDTOTA,SDDFN,SDAPPT,SDAP,SDCLIN,SDENC,SCDATE,SCDFN
+2 NEW SDMISD,SDBADD,SDTOTD,SCDUPEA,SCDUPED,SCTOTE,SCDUPEE,SCDUPEC
+3 NEW SCSTOP,SDSTOP,SDDI,SDDISP,SDDATE,SCAPAT,SCADAT,SCASTP,SCDPAT,SCDDAT
+4 NEW SDPAT,SCADT,SCDDT,SDANE,SDANP,SDANA,SDDNE,SDDNP,SDDND,ZTSTOP
+5 SET (SDMISA,SDBADA,SDTOTA,SDMISD,SDBADD,SDTOTD,SDDFN,SCDUPEA,SCDUPEE)=0
+6 SET (SCDUPED,SDPAT,SCDUPEC,SCTOTE,SCAPAT,SCADAT,SCASTP,SCDPAT,SCDDAT)=0
+7 SET (SCADT,SCDDT,SDANE,SDANP,SDANA,SDDNE,SDDNP,SDDND,ZTSTOP)=0
+8 FOR SDPAT=1:1
SET SDDFN=$ORDER(^DPT(+SDDFN))
if +SDDFN=0
QUIT
Begin DoDot:1
+9 SET ZTSTOP=$$S^%ZTLOAD
+10 DO APPT
+11 DO DISP
End DoDot:1
if ZTSTOP
QUIT
+12 IF ZTSTOP
DO OUTPUT
QUIT
+13 DO DUP
+14 DO OUTPUT
+15 QUIT
OUTPUT ; create text for MailMan message
+1 NEW SDLINE,Y
+2 SET CTR=$ORDER(@SDTEXT@(99999999),-1)
+3 SET SDLINE=""
SET $PIECE(SDLINE,"-",78)=""
+4 SET Y=$$SITE^VASITE()
+5 DO BLDTXT(.CTR," Reporting Site: "_$PIECE(Y,"^",2)_" ("_$PIECE(Y,"^",3)_")",SDTEXT)
+6 DO BLDTXT(.CTR," Number of patients: "_SDPAT,SDTEXT)
+7 SET BEGDATE=$$FMTE^XLFDT(BEGDATE)
+8 SET ENDDATE=$$FMTE^XLFDT($PIECE(ENDDATE,".",1))
+9 DO BLDTXT(.CTR,"Encounter Start Date: "_BEGDATE,SDTEXT)
+10 DO BLDTXT(.CTR," Encounter End Date: "_ENDDATE,SDTEXT)
+11 DO BLDTXT(.CTR," ",SDTEXT)
+12 IF ZTSTOP
DO BLDTXT(.CTR,"*** Task halted at user request ***",SDTEXT)
+13 DO BLDTXT(.CTR,SDLINE,SDTEXT)
+14 DO BLDTXT(.CTR,"PATIENT APPOINTMENT MULTIPLE vs. OUTPATIENT ENCOUNTER FILE:",SDTEXT)
+15 DO BLDTXT(.CTR," ",SDTEXT)
+16 DO BLDTXT(.CTR,"Appointment does not point to an encounter: "_SDANE,SDTEXT)
+17 DO BLDTXT(.CTR," Pointed-to encounter is missing: "_SDMISA,SDTEXT)
+18 DO BLDTXT(.CTR,"Pointed-to encounter has inconsistent data: "_SDBADA,SDTEXT)
+19 DO BLDTXT(.CTR," Not a parent: "_SDANP,SDTEXT)
+20 DO BLDTXT(.CTR," Not an appointment: "_SDANA,SDTEXT)
+21 DO BLDTXT(.CTR," Patient: "_SCAPAT,SDTEXT)
+22 DO BLDTXT(.CTR," Date: "_SCADAT,SDTEXT)
+23 DO BLDTXT(.CTR," Time: "_SCADT,SDTEXT)
+24 DO BLDTXT(.CTR," Stop code: "_SCASTP,SDTEXT)
+25 DO BLDTXT(.CTR," ",.SDTEXT)
+26 DO BLDTXT(.CTR,SDMISA+SDBADA+SDANE_" total errors out of "_SDTOTA_" appointment records.",SDTEXT)
+27 DO BLDTXT(.CTR," ",SDTEXT)
+28 DO BLDTXT(.CTR,"NOTE: The stop code from the PATIENT file Appointment multiple was compared",SDTEXT)
+29 DO BLDTXT(.CTR,"against the stop code in the pointed-to encounter, and non-matches",SDTEXT)
+30 DO BLDTXT(.CTR,"were counted. Because stop codes are being added and deactivated over time,",SDTEXT)
+31 DO BLDTXT(.CTR,"a true comparison of the stop code of the clinic with the stop code of the",SDTEXT)
+32 DO BLDTXT(.CTR,"appointment/encounter is probably impossible without human review.",SDTEXT)
+33 DO BLDTXT(.CTR,SDLINE,SDTEXT)
+34 DO BLDTXT(.CTR,"PATIENT DISPOSITION MULTIPLE vs. OUTPATIENT ENCOUNTER FILE:",SDTEXT)
+35 DO BLDTXT(.CTR," ",SDTEXT)
+36 DO BLDTXT(.CTR,"Disposition does not point to an encounter: "_SDDNE,SDTEXT)
+37 DO BLDTXT(.CTR," Pointed-to encounter is missing: "_SDMISD,SDTEXT)
+38 DO BLDTXT(.CTR,"Pointed-to encounter has inconsistent data: "_SDBADD,SDTEXT)
+39 DO BLDTXT(.CTR," Not a parent: "_SDDNP,SDTEXT)
+40 DO BLDTXT(.CTR," Not a disposition: "_SDDND,SDTEXT)
+41 DO BLDTXT(.CTR," Patient: "_SCDPAT,SDTEXT)
+42 DO BLDTXT(.CTR," Date: "_SCDDAT,SDTEXT)
+43 DO BLDTXT(.CTR," Time: "_SCDDT,SDTEXT)
+44 DO BLDTXT(.CTR," ",SDTEXT)
+45 DO BLDTXT(.CTR,SDMISD+SDBADD+SDDNE_" total errors out of "_SDTOTD_" disposition records.",SDTEXT)
+46 DO BLDTXT(.CTR," ",SDTEXT)
+47 DO BLDTXT(.CTR,SDLINE,SDTEXT)
+48 DO BLDTXT(.CTR,"POSSIBLY DUPLICATE ENCOUNTERS: ",SDTEXT)
+49 DO BLDTXT(.CTR," ",SDTEXT)
+50 DO BLDTXT(.CTR,"Duplicate appointment encounters: "_SCDUPEA,SDTEXT)
+51 DO BLDTXT(.CTR," Duplicate add/edit encounters: "_SCDUPEE,SDTEXT)
+52 DO BLDTXT(.CTR,"Duplicate disposition encounters: "_SCDUPED,SDTEXT)
+53 DO BLDTXT(.CTR,"Duplicate credit stop encounters: "_SCDUPEC,SDTEXT)
+54 DO BLDTXT(.CTR," ",SDTEXT)
+55 DO BLDTXT(.CTR,SCDUPEA+SCDUPEE+SCDUPED+SCDUPEC_" total errors out of "_SCTOTE_" encounter records.",SDTEXT)
+56 QUIT
APPT ; check patient appointment multiple
+1 NEW SDOE
+2 SET SDAPPT=SDPDATE
+3 FOR
SET SDAPPT=$ORDER(^DPT(SDDFN,"S",SDAPPT))
if ('SDAPPT)!(SDAPPT>ENDDATE)
QUIT
Begin DoDot:1
+4 SET SDTOTA=SDTOTA+1
+5 SET SDAP=$GET(^DPT(SDDFN,"S",SDAPPT,0))
if 'SDAP
QUIT
+6 SET SDCLIN=$PIECE(SDAP,"^",1)
SET SDSTOP=$PIECE(^SC(SDCLIN,0),"^",7)
+7 SET SDENC=$PIECE(SDAP,"^",20)
+8 IF 'SDENC
if ($PIECE(SDAP,"^",2)="NT")
SET SDANE=SDANE+1
QUIT
+9 IF '$DATA(^SCE(SDENC))
SET SDMISA=SDMISA+1
QUIT
+10 SET SDOE=$GET(^SCE(SDENC,0))
+11 ;not a parent encounter
IF $PIECE(SDOE,"^",6)
SET SDANP=SDANP+1
SET SDBADA=SDBADA+1
QUIT
+12 ;not an appointment
IF $PIECE(SDOE,"^",8)'=1
SET SDANA=SDANA+1
SET SDBADA=SDBADA+1
QUIT
+13 SET SCDATE=$PIECE(SDOE,"^",1)
+14 SET SCDFN=$PIECE(SDOE,"^",2)
+15 SET SCSTOP=$PIECE(SDOE,"^",3)
+16 IF SDDFN'=SCDFN
SET SCAPAT=SCAPAT+1
SET SDBADA=SDBADA+1
QUIT
+17 IF $PIECE(SCDATE,".",1)'=$PIECE(SDAPPT,".",1)
SET SCADAT=SCADAT+1
SET SDBADA=SDBADA+1
QUIT
+18 IF $PIECE(SCDATE,".",2)'=$PIECE(SDAPPT,".",2)
SET SCADT=SCADT+1
SET SDBADA=SDBADA+1
QUIT
+19 IF SCSTOP'=SDSTOP
SET SCASTP=SCASTP+1
SET SDBADA=SDBADA+1
QUIT
End DoDot:1
+20 QUIT
DISP ; check patient disposition multiple
+1 NEW SDOE
+2 SET SDDISP=9999999-ENDDATE
+3 FOR
SET SDDISP=$ORDER(^DPT(SDDFN,"DIS",SDDISP))
if ('SDDISP)!((9999999-SDDISP)<SDPDATE)
QUIT
Begin DoDot:1
+4 SET SDTOTD=SDTOTD+1
+5 SET SDDI=$GET(^DPT(SDDFN,"DIS",SDDISP,0))
if 'SDDI
QUIT
+6 IF $PIECE(SDDI,"^",2)=2
QUIT
+7 SET SDENC=$PIECE(SDDI,"^",18)
+8 IF 'SDENC
if (+$PIECE(SDDI,"^",6))
SET SDDNE=SDDNE+1
QUIT
+9 IF '$DATA(^SCE(SDENC))
SET SDMISD=SDMISD+1
QUIT
+10 SET SDOE=$GET(^SCE(SDENC,0))
+11 ;not a parent encounter
IF $PIECE(SDOE,"^",6)
SET SDDNP=SDDNP+1
SET SDBADD=SDBADD+1
QUIT
+12 ;not a disposition
IF $PIECE(SDOE,"^",8)'=3
SET SDDND=SDDND+1
SET SDBADD=SDBADD+1
QUIT
+13 SET SDDATE=$PIECE(SDDI,"^",1)
+14 SET SCDATE=$PIECE(SDOE,"^",1)
+15 SET SCDFN=$PIECE(SDOE,"^",2)
+16 IF SDDFN'=SCDFN
SET SCDPAT=SCDPAT+1
SET SDBADD=SDBADD+1
QUIT
+17 IF $PIECE(SCDATE,".",1)'=$PIECE(SDDATE,".",1)
SET SCDDAT=SCDDAT+1
SET SDBADD=SDBADD+1
QUIT
+18 IF $PIECE(SCDATE,".",2)'=$PIECE(SDDATE,".",2)
SET SCDDT=SCDDT+1
SET SDBADD=SDBADD+1
QUIT
End DoDot:1
+19 QUIT
DUP ; loop through outpatient encounter file - call DUPCHECK
+1 NEW SCDFN,SCDT,SCENC,SCREC1,SCREC2,SCNUM1,SCNUM2
+2 SET (SCDFN,SCDT,SCREC1,SCREC2,SCNUM1,SCNUM2,SCENC)=""
+3 FOR
SET SCDFN=$ORDER(^SCE("ADFN",SCDFN))
if 'SCDFN
QUIT
Begin DoDot:1
+4 SET ZTSTOP=$$S^%ZTLOAD
+5 SET SCDT=SDPDATE
+6 FOR
SET SCDT=$ORDER(^SCE("ADFN",SCDFN,SCDT))
if ('SCDT)!(SCDT>ENDDATE)
QUIT
Begin DoDot:2
+7 SET SCENC=""
+8 FOR
SET SCENC=$ORDER(^SCE("ADFN",SCDFN,SCDT,SCENC))
if 'SCENC
QUIT
DO DUPCHECK
End DoDot:2
End DoDot:1
if ZTSTOP
QUIT
+9 QUIT
DUPCHECK ; check for duplicates
+1 SET SCTOTE=SCTOTE+1
+2 SET SCNUM1=SCENC
SET SCREC1=$GET(^SCE(+SCENC,0))
if 'SCREC1
QUIT
+3 SET SCNUM2=$ORDER(^SCE("ADFN",SCDFN,SCDT,SCNUM1))
if SCNUM2=""
QUIT
+4 SET SCREC2=$GET(^SCE(+SCNUM2,0))
if 'SCREC2
QUIT
+5 ;not a parent encounter
if $PIECE(SCREC1,"^",6)!($PIECE(SCREC2,"^",6))
QUIT
+6 ;not same date/patient/stop
if $PIECE(SCREC2,"^",1,3)'=$PIECE(SCREC1,"^",1,3)
QUIT
+7 ;not same Visit ID
if $PIECE(SCREC2,"^",5)'=$PIECE(SCREC1,"^",5)
QUIT
+8 ;not same Orig Proc
if $PIECE(SCREC2,"^",8)'=$PIECE(SCREC1,"^",8)
QUIT
+9 IF $PIECE(SCREC1,"^",8)=1
SET SCDUPEA=SCDUPEA+1
QUIT
+10 IF $PIECE(SCREC1,"^",8)=2
SET SCDUPEE=SCDUPEE+1
QUIT
+11 IF $PIECE(SCREC1,"^",8)=3
SET SCDUPED=SCDUPED+1
QUIT
+12 IF $PIECE(SCREC1,"^",8)=4
SET SCDUPEC=SCDUPEC+1
QUIT
+13 QUIT
