90 lines
6.9 KiB
Mathematica
90 lines
6.9 KiB
Mathematica
SCRPW1 ;RENO/KEITH - Review of Scheduling/Outpatient Encounter/Visit file relationships ; 03 Aug 98 10:56 AM
|
|
;;5.3;Scheduling;**139,132,144**;AUG 13, 1993
|
|
ASK ;Ask for patient
|
|
D TITL^SCRPW50("Review of Scheduling/PCE/Problem List Data")
|
|
W ! S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC G:($D(DTOUT)!$D(DUOUT)) EXIT G:Y'>0 EXIT S DFN=+Y,SDPNAM=$P(Y,U,2)
|
|
DT K %DT S %DT="AEPX",%DT("A")="Encounter date: " D ^%DT G:$D(DTOUT) EXIT G:X=""!(X=U) EXIT G:Y=-1 DT S SDBDT=Y-.0000001,SDEDT=Y+.999999 X ^DD("DD") S SDENC=Y
|
|
W ! K DIR S DIR(0)="S^S:SHORT;L:LONG",DIR("A")="Select report format",DIR("B")="LONG",DIR("?",1)="The SHORT format returns data from the Scheduling package databases including"
|
|
S DIR("?",2)="information from the PATIENT, HOSPITAL LOCATION, SCHEDULING VISITS, OUTPATIENT",DIR("?",3)="ENCOUNTER/DIAGNOSIS/PROVIDER, TRANSMITTED OUTPATIENT ENCOUNTER and TRANSMITTED"
|
|
S DIR("?",4)="OUTPATIENT ENCOUNTER ERROR files. The LONG format also includes information",DIR("?")="from the VISIT and 'V files', as well as, PROBLEM LIST."
|
|
D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SDFMT=Y
|
|
F Y="SDENC","SDFMT","DFN","SDPNAM","SDEDT","SDBDT","SDBD","SDED" S ZTSAVE(Y)=""
|
|
S ZTRTN="START^SCRPW1",ZTDESC="Review of Encounter Data" W ! D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) D EXIT G ASK
|
|
START D:$E(IOST)="C" DISP0^SCRPW23
|
|
D DEM^VADPT S SDSSN=$P(VADM(2),U,2),SDPAGE=1,SDDAY=SDBDT,(SDFOUND,SDOUT)=0 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDLINE="",$P(SDLINE,"-",81)=""
|
|
W:$E(IOST)="C" $$XY^SCRPW50(IOF,1,0) D H1 W !,"------------------------- *** SCHEDULING DATABASE *** --------------------------",!,"==> REGISTRATION/DISPOSITION DATA -- "
|
|
S SDDAY=(9999999-SDEDT) F S SDDAY=$O(^DPT(DFN,"DIS",SDDAY)) Q:('SDDAY!SDOUT!(SDDAY>(9999999-SDBDT))) S SDFOUND=1 D DISP
|
|
G:SDOUT EXIT W:'SDFOUND "No disposition information found." S SDFOUND=0 D:$Y>(IOSL-10) HDR G:SDOUT EXIT W !,"==> APPOINTMENT DATA -- "
|
|
S SDDAY=SDBDT F S SDDAY=$O(^DPT(DFN,"S",SDDAY)) Q:('SDDAY!((SDDAY>SDEDT)!(SDOUT))) S SDFOUND=1,SDLOC=$P(^DPT(DFN,"S",SDDAY,0),U) D APPT
|
|
G:SDOUT EXIT W:'SDFOUND "No appointment information found."
|
|
OEPR D:$Y>(IOSL-10) HDR G:SDOUT EXIT S SDFOUND=0
|
|
W !,"-------------------- *** OUTPATIENT ENCOUNTER DATABASE *** ---------------------",!,"==> OUTPATIENT ENCOUNTER DATA -- "
|
|
S SDDAY=SDBDT F S SDDAY=$O(^SCE("ADFN",DFN,SDDAY)) Q:('SDDAY!SDOUT!(SDDAY>SDEDT)) S SDOENC=0 F S SDOENC=$O(^SCE("ADFN",DFN,SDDAY,SDOENC)) Q:('SDOENC!SDOUT) S SDFOUND=1 D OENC
|
|
G:SDOUT EXIT W:'SDFOUND "No encounter information found." D:$Y>(IOSL-10) HDR G:SDOUT!(SDFMT="S") END S SDFOUND=0
|
|
W !,"----------------------- *** VISIT TRACKING DATABASE *** ------------------------",!,"==> VISIT DATA -- "
|
|
S SDDAY=(9999999-$P(SDEDT,"."))
|
|
F S SDDAY=$O(^AUPNVSIT("AA",DFN,SDDAY)) Q:('SDDAY!SDOUT!(SDDAY>(9999999-$P(SDBDT,".")))) S SDVSIT=0 F S SDVSIT=$O(^AUPNVSIT("AA",DFN,SDDAY,SDVSIT)) Q:('SDVSIT!SDOUT) S SDFOUND=1 D VSIT
|
|
G:SDOUT EXIT W:'SDFOUND "No visit information found." D:$Y>(IOSL-10) HDR G:SDOUT EXIT S SDFOUND=0
|
|
W !,"------------------------- *** PATIENT PROBLEM LIST *** -------------------------",!
|
|
S DIC="^AUPNPROB(",DR="0:~",DA=0 F S DA=$O(^AUPNPROB("AC",DFN,DA)) Q:('DA!SDOUT) S SDFOUND=1 D:$Y>(IOSL-10) HDR G:SDOUT EXIT W ! D EN^DIQ
|
|
G:SDOUT EXIT W:'SDFOUND "No Problem List information found."
|
|
END I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
|
|
EXIT D END^SCRPW50 K SDBDT,SDCLP,SDDAY,DFN,SDEDT,SDFNAM,SDFOUND,SDLOC,SDOENC,SDPNAM,SDVFGL,SDVFR,SDVSIT,DA,DIC,DR,DTOUT,DUOUT,SDPNOW,SDSSN,SDLINE,Y
|
|
D KVA^VADPT K %DT,ZTRTN,ZTDESC,ZTSAVE,SDOEHX,SDOENCC,SDTY,SDCHI,SDPAR,SDFMT,SDENC,DIR,SDTOENC,SDDOENC,SDEOENC,SDERR,SDOUT,SDPAGE,%,X Q
|
|
;
|
|
HDR I $E(IOST)="C",SDPAGE'=1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
|
|
H1 D STOP Q:SDOUT W:SDPAGE'=1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
|
|
W "REVIEW OF SCHEDULING/PCE/PROBLEM LIST DATA",!,"Patient: ",SDPNAM,?44,"SSN: ",SDSSN
|
|
W !,"Encounter date: ",SDENC,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"PAGE: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
|
|
;
|
|
DISP D:$Y>(IOSL-10) HDR Q:SDOUT W !,"PATIENT file info:",! S DIC="^DPT("_DFN_",""DIS"",",DA=SDDAY,DR="0:~" D EN^DIQ Q
|
|
;
|
|
STOP ;Check for stop task request
|
|
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
|
;
|
|
APPT D:$Y>(IOSL-10) HDR Q:SDOUT W !,"PATIENT file info:",! S DIC="^DPT("_DFN_",""S"",",DA=SDDAY,DR="0:~" D EN^DIQ
|
|
S SDCLP=0 F S SDCLP=$O(^SC(SDLOC,"S",SDDAY,1,SDCLP)) Q:'SDCLP Q:$P(^SC(SDLOC,"S",SDDAY,1,SDCLP,0),U)=DFN
|
|
Q:'SDCLP D:$Y>(IOSL-10) HDR Q:SDOUT W !,"HOSPITAL LOCATION file info:",! S DIC="^SC("_SDLOC_",""S"","_SDDAY_",1,",DA=SDCLP,DR="0:~" D EN^DIQ Q
|
|
;
|
|
OENC S SDPAR=$P(^SCE(SDOENC,0),U,6) I SDPAR,$D(^SCE(SDPAR,0)) Q
|
|
S SDTY=$S(SDPAR:"un-parented child",1:"parent") D OENC1(SDOENC,SDTY)
|
|
S SDCHI=0 F S SDCHI=$O(^SCE("APAR",SDOENC,SDCHI)) Q:'SDCHI!SDOUT D OENC1(SDCHI,"child")
|
|
Q
|
|
;
|
|
OENC1(SDOENC,SDTY) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"OUTPATIENT ENCOUNTER file """_SDTY_""" record #"_SDOENC_":",! S DIC="^SCE(",DA=SDOENC,DR="0:~" D EN^DIQ D OENCC,TOENC Q
|
|
;
|
|
OENCC S SDOENCC=0 F S SDOENCC=$O(^SDD(409.42,"OE",SDOENC,SDOENCC)) Q:'SDOENCC D:$Y>(IOSL-10) HDR Q:SDOUT W !,"OUTPATIENT CLASSIFICATION file info:",! S DIC="^SDD(409.42,",DA=SDOENCC,DR="0:~" D EN^DIQ
|
|
Q
|
|
;
|
|
VSIT S SDPAR=$P(^AUPNVSIT(SDVSIT,0),U,12) I SDPAR,$D(^AUPNVSIT(SDPAR,0)) Q
|
|
S SDTY=$S(SDPAR:"un-parented child",1:"parent") D VSIT1(SDVSIT,SDTY)
|
|
S SDCHI=0 F S SDCHI=$O(^AUPNVSIT("AD",SDVSIT,SDCHI)) Q:'SDCHI!SDOUT D VSIT1(SDCHI,"child")
|
|
Q
|
|
;
|
|
VSIT1(SDVSIT,SDTY) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"VISIT file """_SDTY_""" record #"_SDVSIT_":",! S DIC="^AUPNVSIT(",DA=SDVSIT,DR="0:~" D EN^DIQ,MVSIT Q
|
|
;
|
|
MVSIT N SDVBASE,SDVN,SDID,SDFNAM,SDVFGL
|
|
S SDVBASE=9000010
|
|
F SDVN=.06,.07,.11,.12,.13,.15,.16,.18,.23 Q:SDOUT K SDID D FILE^DID(SDVBASE+SDVN,"","NAME;GLOBAL NAME","SDID") S SDFNAM=$G(SDID("NAME")),SDVFGL=$G(SDID("GLOBAL NAME")) D:$L(SDVFGL) MVFP
|
|
Q
|
|
;
|
|
MVFP S SDVFR=0 F S SDVFR=$O(@(SDVFGL_"""AD"","_SDVSIT_","_SDVFR_")")) Q:'SDVFR!SDOUT D MVFP1
|
|
Q
|
|
;
|
|
MVFP1 D:$Y>(IOSL-10) HDR Q:SDOUT W !,SDFNAM," file info:",! S DIC=SDVFGL,DA=SDVFR,DR="0:~" D EN^DIQ Q
|
|
;
|
|
TOENC S SDTOENC=$O(^SD(409.73,"AENC",SDOENC,0)) Q:'SDTOENC D:$Y>(IOSL-10) HDR Q:SDOUT W !,"TRANSMITTED OUTPATIENT ENCOUNTER info:",! S DIC="^SD(409.73,",DA=SDTOENC,DR="0:~" D EN^DIQ
|
|
S SDDOENC=$P(^SD(409.73,SDTOENC,0),U,3) I SDDOENC D:$Y>(IOSL-10) HDR Q:SDOUT W !,"DELETED OUTPATIENT ENCOUNTER info:",! S DIC="^SD(409.74,",DA=SDDOENC,DR="0:~" D EN^DIQ
|
|
D TOERR,TOEHX Q
|
|
;
|
|
TOERR Q:'$D(^SD(409.75,"B",SDTOENC)) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"TRANSMITTED OUTPATIENT ENCOUNTER ERROR info:",!
|
|
S SDEOENC=0 F S SDEOENC=$O(^SD(409.75,"B",SDTOENC,SDEOENC)) Q:'SDEOENC!SDOUT S SDERR=$P(^SD(409.75,SDEOENC,0),U,2) D:SDERR TERR
|
|
Q
|
|
;
|
|
TOEHX Q:'$D(^SD(409.77,"B",SDTOENC)) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"ACRP TRANSMISSION HISTORY info:",!
|
|
S SDOEHX=0 F S SDOEHX=$O(^SD(409.77,"B",SDTOENC,SDOEHX)) Q:'SDOEHX D:$Y>(IOSL-10) HDR Q:SDOUT S DIC="^SD(409.77,",DA=SDOEHX,DR="0:~" D EN^DIQ
|
|
Q
|
|
;
|
|
TERR D:$Y>(IOSL-8) HDR Q:SDOUT W !?4,"Error Code: ",$P($G(^SD(409.76,SDERR,0)),U)," ",$P($G(^SD(409.76,SDERR,1)),U)
|
|
Q
|