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