- 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 Dec 13, 2024@02:44:49 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