Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD53120A

SD53120A.m

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