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

SCRPW1.m

Go to the documentation of this file.
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