source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW1.m@ 905

Last change on this file since 905 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1SCRPW1 ;RENO/KEITH - Review of Scheduling/Outpatient Encounter/Visit file relationships ; 03 Aug 98 10:56 AM
2 ;;5.3;Scheduling;**139,132,144**;AUG 13, 1993
3ASK ;Ask for patient
4 D TITL^SCRPW50("Review of Scheduling/PCE/Problem List Data")
5 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)
6DT 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
7 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"
8 S DIR("?",2)="information from the PATIENT, HOSPITAL LOCATION, SCHEDULING VISITS, OUTPATIENT",DIR("?",3)="ENCOUNTER/DIAGNOSIS/PROVIDER, TRANSMITTED OUTPATIENT ENCOUNTER and TRANSMITTED"
9 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."
10 D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SDFMT=Y
11 F Y="SDENC","SDFMT","DFN","SDPNAM","SDEDT","SDBDT","SDBD","SDED" S ZTSAVE(Y)=""
12 S ZTRTN="START^SCRPW1",ZTDESC="Review of Encounter Data" W ! D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) D EXIT G ASK
13START D:$E(IOST)="C" DISP0^SCRPW23
14 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)=""
15 W:$E(IOST)="C" $$XY^SCRPW50(IOF,1,0) D H1 W !,"------------------------- *** SCHEDULING DATABASE *** --------------------------",!,"==> REGISTRATION/DISPOSITION DATA -- "
16 S SDDAY=(9999999-SDEDT) F S SDDAY=$O(^DPT(DFN,"DIS",SDDAY)) Q:('SDDAY!SDOUT!(SDDAY>(9999999-SDBDT))) S SDFOUND=1 D DISP
17 G:SDOUT EXIT W:'SDFOUND "No disposition information found." S SDFOUND=0 D:$Y>(IOSL-10) HDR G:SDOUT EXIT W !,"==> APPOINTMENT DATA -- "
18 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
19 G:SDOUT EXIT W:'SDFOUND "No appointment information found."
20OEPR D:$Y>(IOSL-10) HDR G:SDOUT EXIT S SDFOUND=0
21 W !,"-------------------- *** OUTPATIENT ENCOUNTER DATABASE *** ---------------------",!,"==> OUTPATIENT ENCOUNTER DATA -- "
22 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
23 G:SDOUT EXIT W:'SDFOUND "No encounter information found." D:$Y>(IOSL-10) HDR G:SDOUT!(SDFMT="S") END S SDFOUND=0
24 W !,"----------------------- *** VISIT TRACKING DATABASE *** ------------------------",!,"==> VISIT DATA -- "
25 S SDDAY=(9999999-$P(SDEDT,"."))
26 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
27 G:SDOUT EXIT W:'SDFOUND "No visit information found." D:$Y>(IOSL-10) HDR G:SDOUT EXIT S SDFOUND=0
28 W !,"------------------------- *** PATIENT PROBLEM LIST *** -------------------------",!
29 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
30 G:SDOUT EXIT W:'SDFOUND "No Problem List information found."
31END I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
32EXIT 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
33 D KVA^VADPT K %DT,ZTRTN,ZTDESC,ZTSAVE,SDOEHX,SDOENCC,SDTY,SDCHI,SDPAR,SDFMT,SDENC,DIR,SDTOENC,SDDOENC,SDEOENC,SDERR,SDOUT,SDPAGE,%,X Q
34 ;
35HDR I $E(IOST)="C",SDPAGE'=1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
36H1 D STOP Q:SDOUT W:SDPAGE'=1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
37 W "REVIEW OF SCHEDULING/PCE/PROBLEM LIST DATA",!,"Patient: ",SDPNAM,?44,"SSN: ",SDSSN
38 W !,"Encounter date: ",SDENC,!,"Date printed: ",SDPNOW,?(74-$L(SDPAGE)),"PAGE: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
39 ;
40DISP D:$Y>(IOSL-10) HDR Q:SDOUT W !,"PATIENT file info:",! S DIC="^DPT("_DFN_",""DIS"",",DA=SDDAY,DR="0:~" D EN^DIQ Q
41 ;
42STOP ;Check for stop task request
43 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
44 ;
45APPT D:$Y>(IOSL-10) HDR Q:SDOUT W !,"PATIENT file info:",! S DIC="^DPT("_DFN_",""S"",",DA=SDDAY,DR="0:~" D EN^DIQ
46 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
47 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
48 ;
49OENC S SDPAR=$P(^SCE(SDOENC,0),U,6) I SDPAR,$D(^SCE(SDPAR,0)) Q
50 S SDTY=$S(SDPAR:"un-parented child",1:"parent") D OENC1(SDOENC,SDTY)
51 S SDCHI=0 F S SDCHI=$O(^SCE("APAR",SDOENC,SDCHI)) Q:'SDCHI!SDOUT D OENC1(SDCHI,"child")
52 Q
53 ;
54OENC1(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
55 ;
56OENCC 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
57 Q
58 ;
59VSIT S SDPAR=$P(^AUPNVSIT(SDVSIT,0),U,12) I SDPAR,$D(^AUPNVSIT(SDPAR,0)) Q
60 S SDTY=$S(SDPAR:"un-parented child",1:"parent") D VSIT1(SDVSIT,SDTY)
61 S SDCHI=0 F S SDCHI=$O(^AUPNVSIT("AD",SDVSIT,SDCHI)) Q:'SDCHI!SDOUT D VSIT1(SDCHI,"child")
62 Q
63 ;
64VSIT1(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
65 ;
66MVSIT N SDVBASE,SDVN,SDID,SDFNAM,SDVFGL
67 S SDVBASE=9000010
68 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
69 Q
70 ;
71MVFP S SDVFR=0 F S SDVFR=$O(@(SDVFGL_"""AD"","_SDVSIT_","_SDVFR_")")) Q:'SDVFR!SDOUT D MVFP1
72 Q
73 ;
74MVFP1 D:$Y>(IOSL-10) HDR Q:SDOUT W !,SDFNAM," file info:",! S DIC=SDVFGL,DA=SDVFR,DR="0:~" D EN^DIQ Q
75 ;
76TOENC 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
77 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
78 D TOERR,TOEHX Q
79 ;
80TOERR Q:'$D(^SD(409.75,"B",SDTOENC)) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"TRANSMITTED OUTPATIENT ENCOUNTER ERROR info:",!
81 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
82 Q
83 ;
84TOEHX Q:'$D(^SD(409.77,"B",SDTOENC)) D:$Y>(IOSL-10) HDR Q:SDOUT W !,"ACRP TRANSMISSION HISTORY info:",!
85 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
86 Q
87 ;
88TERR 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)
89 Q
Note: See TracBrowser for help on using the repository browser.