- SCRPW1 ;RENO/KEITH - Review of Scheduling/Outpatient Encounter/Visit file relationships ; 03 Aug 98 10:56 AM
- ;;5.3;Scheduling;**139,132,144,1015**;AUG 13, 1993;Build 21
- 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
- SCRPW1 ;RENO/KEITH - Review of Scheduling/Outpatient Encounter/Visit file relationships ; 03 Aug 98 10:56 AM
- +1 ;;5.3;Scheduling;**139,132,144,1015**;AUG 13, 1993;Build 21
- 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
