SCRPW14 ;RENO/KEITH - Encounter Activity Report ;06/10/99
;;5.3;Scheduling;**139,144,180,593**;AUG 13, 1993;Build 13
;06/10/99 ACS Added cpt modifiers to the report
;
N DIC,DIR,DTOUT,DUOUT,X,Y,SD,ZTSAVE,%DT,SDDIV,SDI
D TITL^SCRPW50("Encounter Activity Report") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
D SUBT^SCRPW50("*** Date Range Selection ***")
S Y=$$IMP^SCRPWICD(30) S SD("I10DTI")=Y X ^DD("DD") S SD("I10DTE")=Y
FDT W ! S %DT="AEPX",%DT("A")="Beginning date: ",%DT(0)="-TODAY" D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
G:Y<1 FDT S SD("BDT")=Y X ^DD("DD") S SD("PBDT")=Y W !
LDT S %DT("A")="Ending date: " D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
I Y<SD("BDT") W !!,$C(7),"Ending date must be after beginning date!",! G LDT
G:Y<1 LDT S SD("EDT")=Y X ^DD("DD") S SD("PEDT")=Y,SD("EDT")=SD("EDT")_".999999"
I (SD("BDT")<SD("I10DTI")),(SD("EDT")'<SD("I10DTI")) D G FDT
. W !!,$C(7),"Beginning and Ending dates must both be prior to "_SD("I10DTE")_" (ICD-9) or both be on or after "_SD("I10DTE")_" (ICD-10)."
CATE D SUBT^SCRPW50("*** Report Category Selection ***")
W ! S DIR(0)="S^C:CLINIC;P:PROVIDER;S:STOP CODE",DIR("A")="Select category for report output" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("CAT")=Y D STAT G:'$D(SD("STAT")) EXIT
D SUBT^SCRPW50("*** Report Format Selection ***")
W ! S DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("A")="Select report format",DIR("B")="SUMMARY" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("FMT")=Y
I SD("FMT")="S" W ! S DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTALS;V:VISIT TOTALS;U:UNIQUE TOTALS",DIR("A")="Select report order",DIR("B")="ALPHABETIC" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("ORD")=Y G QUE
S SD("ORD")="A" D LIST(SD("CAT")) G:'$D(SD("LIST")) EXIT
QUE D SUBT^SCRPW50("*** Selected Report Parameters ***")
W !!,"You have selected the following report parameters:",! D PVIEW^SCRPW15(0)
W ! K DIR S DIR(0)="Y",DIR("A")="OK",DIR("B")="YES" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT G:'Y EXIT
F SDI="SDDIV","SDDIV(","SD(","SDL(" S ZTSAVE(SDI)=""
W ! D EN^XUTMDEVQ("RPT^SCRPW14","OPT. ACTIVITY REPORT",.ZTSAVE)
;
EXIT D END^SCRPW50 Q
;
STAT ;Prompt for encounter statuses to include
D SUBT^SCRPW50("*** Encounter Status Selection ***")
K SD("STAT") W !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
W !?10,"CHECKED IN",!?10,"CHECKED OUT",!?10,"NO ACTION TAKEN",!?10,"INPATIENT APPOINTMENT",!?10,"NON-COUNT",!?10,"ACTION REQUIRED",! N DIC,I S DIC="^SD(409.63,",DIC(0)="AEMQ",DIC("B")="CHECKED OUT"
S DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))",DIC("A")="Select encounter status: " F I=1:1 D ^DIC Q:$D(DTOUT)!$D(DUOUT) S:Y>0 SD("STAT",$P(Y,U))="" K DIC("B") Q:X=""&(I>1)
Q
;
LIST(X) ;Get list for detail
;Output: SD("LIST",ifn)=name
W ! N DIC S DIC=$S(X="C":"^SC(",X="P":"^VA(200,",1:"^DIC(40.7,"),DIC(0)="AEMQ" S:X="S" DIC("S")="I $L($P(^(0),U,2))=3"
F D ^DIC Q:$D(DTOUT)!$D(DUOUT)!(X="") S:Y>0 SD("LIST",$P(Y,U))=$P(Y,U,2)
W ! Q
;
RPT ;Print report
N %,X,Y,SDQ,SDTIT,SDI,DFN,SDIVN,SDMD,SDOUT,SDSTOP,SDX
N SDCH,SDCH0,SDCL,SDCOL,SDD,SDD0,SDDET,SDDT,SDFFS,SDLINE,SDN,SDOE,SDOE0,SDOED,SDOED0,SDP,SDPI,SDP0,SDPAGE,SDPG,SDPNOW,SDPR,SDPT,SDR,SDS,SDSC,SDSV,SDT,SDT1,SDT2,SDTOT,SDTOT1,SDTOT2,SDUN,SDVP,SDVP0,SDVS,SDLIST,SDRPVS,SDRPUN,SDRPEN
K ^TMP("SCRPW",$J) S (SDOUT,SDSTOP)=0,SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
S SDDT=SD("BDT") F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SD("EDT"))!SDOUT S SDOE=0 F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) S SDIV=$P(SDOE0,U,11) D:SDIV EVAL
G:SDOUT EXIT G ^SCRPW15
;
STOP ;Check for stop task request
S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
EVAL ;Evaluate encounter
S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
I '$P(SDOE0,U,6),$$DIV(SDIV),$D(SD("STAT",+$P(SDOE0,U,12))) K SDS I $$CAT(.SDS) D SRT(SDIV) D:SDMD SRT(0) S SDS=0 F S SDS=$O(SDS(SDS)) Q:'SDS D SET
Q
;
DIV(SDIV) ;Evaluate division
Q:'SDDIV 1 Q $D(SDDIV(SDIV))
;
SRT(SDIV) ;Set report total for summary format
Q:SD("FMT")="D" S SDRPEN(SDIV)=$G(SDRPEN(SDIV))+1,^TMP("SCRPW",$J,SDIV,"RPT","PT",+$P(SDOE0,U,2),+$P(SDDT,"."))="" Q
;
SET ;Set global for a division
D SET1(SDIV) D:SDMD SET1(0) Q:SD("FMT")="S"
K SDLIST D GETDX^SDOE(SDOE,"SDLIST")
S SDOED=0 F S SDOED=$O(SDLIST(SDOED)) Q:'SDOED S SDOED0=SDLIST(SDOED) D:$L(SDOED0) DSET(SDIV) D:SDMD DSET(0)
K SDLIST D GETCPT^SDOE(SDOE,"SDLIST")
S SDVP=0 F S SDVP=$O(SDLIST(SDVP)) Q:'SDVP S SDVP0=SDLIST(SDVP) I $L(SDVP0) D PSET(SDIV) D:SDMD PSET(0)
Q
;
SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,SDS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"ENC"))+1,^TMP("SCRPW",$J,SDIV,1,SDS,"PT",+$P(SDOE0,U,2),+$P(SDDT,"."))=""
Q
;
DSET(SDIV) S SDD=+$P(SDOED0,U),SDR=$S($P(SDOED0,U,12)="P":"PRI",1:"SEC"),^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR))+1 Q
;
PSET(SDIV) ;
I SD("CAT")="P",'$$OLD^SDOEUT(SDOE) S SDPR=$P($G(^AUPNVCPT(SDVP,12)),U,4) Q:'$D(SD("LIST",+SDPR))
;S SDP=+$P(SDVP0,U),SDQ=$P(SDVP0,U,16) S:'SDQ SDQ=1 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ Q
;SDP=procedure pointer, SDQ=procedure quantity
S SDP=+$P(SDVP0,U)
S SDQ=$P(SDVP0,U,16)
S:'SDQ SDQ=1
; add quantity to total quantity for current procedure
S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ
;
;Loop through modifiers and add to ^TMP array
N SDMODN,SDMOD
S SDMODN=0
F S SDMODN=+$O(SDLIST(SDVP,1,SDMODN)) Q:'SDMODN D
.S SDMOD=$P(SDLIST(SDVP,1,SDMODN,0),"^")
.;add modifier quantity to array
.S:SDMOD ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD))+SDQ
Q
;
CAT(SDS) ;Determine if encounter fits category
;Required input: SDS array to return list
;Output: SDS(ifn) array=list of category ifns to tally
I SD("CAT")="C" S SDCL=$P(SDOE0,U,4) Q:SDCL<1 0 S:SD("FMT")="S"!$D(SD("LIST",+SDCL)) SDS(SDCL)="" Q $D(SDS)
I SD("CAT")="P" D CATP Q $D(SDS)
I SD("CAT")="S" D CATS Q $D(SDS)
Q 0
;
CATP ;Get providers
K SDLIST D GETPRV^SDOE(SDOE,"SDLIST")
S SDPI=0 F S SDPI=$O(SDLIST(SDPI)) Q:'SDPI S SDP=$P(SDLIST(SDPI),U) S:SD("FMT")="S"!$D(SD("LIST",SDP)) SDS(SDP)=""
Q
;
CATS ;Get stop codes
S SDSC=+$P(SDOE0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
S SDCH=0 F S SDCH=$O(^SCE("APAR",SDOE,SDCH)) Q:'SDCH S SDCH0=$$GETOE^SDOE(SDCH) I $P(SDCH0,U,8)=4 S SDSC=+$P(SDCH0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW14 6543 printed Apr 09, 2024@21:46:41 Page 2
SCRPW14 ;RENO/KEITH - Encounter Activity Report ;06/10/99
+1 ;;5.3;Scheduling;**139,144,180,593**;AUG 13, 1993;Build 13
+2 ;06/10/99 ACS Added cpt modifiers to the report
+3 ;
+4 NEW DIC,DIR,DTOUT,DUOUT,X,Y,SD,ZTSAVE,%DT,SDDIV,SDI
+5 DO TITL^SCRPW50("Encounter Activity Report")
if '$$DIVA^SCRPW17(.SDDIV)
GOTO EXIT
+6 DO SUBT^SCRPW50("*** Date Range Selection ***")
+7 SET Y=$$IMP^SCRPWICD(30)
SET SD("I10DTI")=Y
XECUTE ^DD("DD")
SET SD("I10DTE")=Y
FDT WRITE !
SET %DT="AEPX"
SET %DT("A")="Beginning date: "
SET %DT(0)="-TODAY"
DO ^%DT
if X=U!$DATA(DTOUT)!(X="")
GOTO EXIT
+1 if Y<1
GOTO FDT
SET SD("BDT")=Y
XECUTE ^DD("DD")
SET SD("PBDT")=Y
WRITE !
LDT SET %DT("A")="Ending date: "
DO ^%DT
if X=U!$DATA(DTOUT)!(X="")
GOTO EXIT
+1 IF Y<SD("BDT")
WRITE !!,$CHAR(7),"Ending date must be after beginning date!",!
GOTO LDT
+2 if Y<1
GOTO LDT
SET SD("EDT")=Y
XECUTE ^DD("DD")
SET SD("PEDT")=Y
SET SD("EDT")=SD("EDT")_".999999"
+3 IF (SD("BDT")<SD("I10DTI"))
IF (SD("EDT")'<SD("I10DTI"))
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"Beginning and Ending dates must both be prior to "_SD("I10DTE")_" (ICD-9) or both be on or after "_SD("I10DTE")_" (ICD-10)."
End DoDot:1
GOTO FDT
CATE DO SUBT^SCRPW50("*** Report Category Selection ***")
+1 WRITE !
SET DIR(0)="S^C:CLINIC;P:PROVIDER;S:STOP CODE"
SET DIR("A")="Select category for report output"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SET SD("CAT")=Y
DO STAT
if '$DATA(SD("STAT"))
GOTO EXIT
+2 DO SUBT^SCRPW50("*** Report Format Selection ***")
+3 WRITE !
SET DIR(0)="S^D:DETAILED;S:SUMMARY"
SET DIR("A")="Select report format"
SET DIR("B")="SUMMARY"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SET SD("FMT")=Y
+4 IF SD("FMT")="S"
WRITE !
SET DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTALS;V:VISIT TOTALS;U:UNIQUE TOTALS"
SET DIR("A")="Select report order"
SET DIR("B")="ALPHABETIC"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SET SD("ORD")=Y
GOTO QUE
+5 SET SD("ORD")="A"
DO LIST(SD("CAT"))
if '$DATA(SD("LIST"))
GOTO EXIT
QUE DO SUBT^SCRPW50("*** Selected Report Parameters ***")
+1 WRITE !!,"You have selected the following report parameters:",!
DO PVIEW^SCRPW15(0)
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="OK"
SET DIR("B")="YES"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
if 'Y
GOTO EXIT
+3 FOR SDI="SDDIV","SDDIV(","SD(","SDL("
SET ZTSAVE(SDI)=""
+4 WRITE !
DO EN^XUTMDEVQ("RPT^SCRPW14","OPT. ACTIVITY REPORT",.ZTSAVE)
+5 ;
EXIT DO END^SCRPW50
QUIT
+1 ;
STAT ;Prompt for encounter statuses to include
+1 DO SUBT^SCRPW50("*** Encounter Status Selection ***")
+2 KILL SD("STAT")
WRITE !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
+3 WRITE !?10,"CHECKED IN",!?10,"CHECKED OUT",!?10,"NO ACTION TAKEN",!?10,"INPATIENT APPOINTMENT",!?10,"NON-COUNT",!?10,"ACTION REQUIRED",!
NEW DIC,I
SET DIC="^SD(409.63,"
SET DIC(0)="AEMQ"
SET DIC("B")="CHECKED OUT"
+4 SET DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))"
SET DIC("A")="Select encounter status: "
FOR I=1:1
DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y>0
SET SD("STAT",$PIECE(Y,U))=""
KILL DIC("B")
if X=""&(I>1)
QUIT
+5 QUIT
+6 ;
LIST(X) ;Get list for detail
+1 ;Output: SD("LIST",ifn)=name
+2 WRITE !
NEW DIC
SET DIC=$SELECT(X="C":"^SC(",X="P":"^VA(200,",1:"^DIC(40.7,")
SET DIC(0)="AEMQ"
if X="S"
SET DIC("S")="I $L($P(^(0),U,2))=3"
+3 FOR
DO ^DIC
if $DATA(DTOUT)!$DATA(DUOUT)!(X="")
QUIT
if Y>0
SET SD("LIST",$PIECE(Y,U))=$PIECE(Y,U,2)
+4 WRITE !
QUIT
+5 ;
RPT ;Print report
+1 NEW %,X,Y,SDQ,SDTIT,SDI,DFN,SDIVN,SDMD,SDOUT,SDSTOP,SDX
+2 NEW SDCH,SDCH0,SDCL,SDCOL,SDD,SDD0,SDDET,SDDT,SDFFS,SDLINE,SDN,SDOE,SDOE0,SDOED,SDOED0,SDP,SDPI,SDP0,SDPAGE,SDPG,SDPNOW,SDPR,SDPT,SDR,SDS,SDSC,SDSV,SDT,SDT1,SDT2,SDTOT,SDTOT1,SDTOT2,SDUN,SDVP,SDVP0,SDVS,SDLIST,SDRPVS,SDRPUN,SDRPEN
+3 KILL ^TMP("SCRPW",$JOB)
SET (SDOUT,SDSTOP)=0
SET SDMD=$ORDER(SDDIV(""))
SET SDMD=$ORDER(SDDIV(SDMD))
if $PIECE(SDDIV,U,2)="ALL DIVISIONS"
SET SDMD=1
+4 SET SDDT=SD("BDT")
FOR
SET SDDT=$ORDER(^SCE("B",SDDT))
if 'SDDT!(SDDT>SD("EDT"))!SDOUT
QUIT
SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("B",SDDT,SDOE))
if 'SDOE!SDOUT
QUIT
SET SDOE0=$$GETOE^SDOE(SDOE)
IF $LENGTH(SDOE0)
SET SDIV=$PIECE(SDOE0,U,11)
if SDIV
DO EVAL
+5 if SDOUT
GOTO EXIT
GOTO ^SCRPW15
+6 ;
STOP ;Check for stop task request
+1 if $GET(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
EVAL ;Evaluate encounter
+1 SET SDSTOP=SDSTOP+1
IF SDSTOP#3000=0
DO STOP
if SDOUT
QUIT
+2 IF '$PIECE(SDOE0,U,6)
IF $$DIV(SDIV)
IF $DATA(SD("STAT",+$PIECE(SDOE0,U,12)))
KILL SDS
IF $$CAT(.SDS)
DO SRT(SDIV)
if SDMD
DO SRT(0)
SET SDS=0
FOR
SET SDS=$ORDER(SDS(SDS))
if 'SDS
QUIT
DO SET
+3 QUIT
+4 ;
DIV(SDIV) ;Evaluate division
+1 if 'SDDIV
QUIT 1
QUIT $DATA(SDDIV(SDIV))
+2 ;
SRT(SDIV) ;Set report total for summary format
+1 if SD("FMT")="D"
QUIT
SET SDRPEN(SDIV)=$GET(SDRPEN(SDIV))+1
SET ^TMP("SCRPW",$JOB,SDIV,"RPT","PT",+$PIECE(SDOE0,U,2),+$PIECE(SDDT,"."))=""
QUIT
+2 ;
SET ;Set global for a division
+1 DO SET1(SDIV)
if SDMD
DO SET1(0)
if SD("FMT")="S"
QUIT
+2 KILL SDLIST
DO GETDX^SDOE(SDOE,"SDLIST")
+3 SET SDOED=0
FOR
SET SDOED=$ORDER(SDLIST(SDOED))
if 'SDOED
QUIT
SET SDOED0=SDLIST(SDOED)
if $LENGTH(SDOED0)
DO DSET(SDIV)
if SDMD
DO DSET(0)
+4 KILL SDLIST
DO GETCPT^SDOE(SDOE,"SDLIST")
+5 SET SDVP=0
FOR
SET SDVP=$ORDER(SDLIST(SDVP))
if 'SDVP
QUIT
SET SDVP0=SDLIST(SDVP)
IF $LENGTH(SDVP0)
DO PSET(SDIV)
if SDMD
DO PSET(0)
+6 QUIT
+7 ;
SET1(SDIV) SET ^TMP("SCRPW",$JOB,SDIV,1,SDS,"ENC")=$GET(^TMP("SCRPW",$JOB,SDIV,1,SDS,"ENC"))+1
SET ^TMP("SCRPW",$JOB,SDIV,1,SDS,"PT",+$PIECE(SDOE0,U,2),+$PIECE(SDDT,"."))=""
+1 QUIT
+2 ;
DSET(SDIV) SET SDD=+$PIECE(SDOED0,U)
SET SDR=$SELECT($PIECE(SDOED0,U,12)="P":"PRI",1:"SEC")
SET ^TMP("SCRPW",$JOB,SDIV,1,SDS,"DX",SDD,SDR)=$GET(^TMP("SCRPW",$JOB,SDIV,1,SDS,"DX",SDD,SDR))+1
QUIT
+1 ;
PSET(SDIV) ;
+1 IF SD("CAT")="P"
IF '$$OLD^SDOEUT(SDOE)
SET SDPR=$PIECE($GET(^AUPNVCPT(SDVP,12)),U,4)
if '$DATA(SD("LIST",+SDPR))
QUIT
+2 ;S SDP=+$P(SDVP0,U),SDQ=$P(SDVP0,U,16) S:'SDQ SDQ=1 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ Q
+3 ;SDP=procedure pointer, SDQ=procedure quantity
+4 SET SDP=+$PIECE(SDVP0,U)
+5 SET SDQ=$PIECE(SDVP0,U,16)
+6 if 'SDQ
SET SDQ=1
+7 ; add quantity to total quantity for current procedure
+8 SET ^TMP("SCRPW",$JOB,SDIV,1,SDS,"PROC",SDP)=$GET(^TMP("SCRPW",$JOB,SDIV,1,SDS,"PROC",SDP))+SDQ
+9 ;
+10 ;Loop through modifiers and add to ^TMP array
+11 NEW SDMODN,SDMOD
+12 SET SDMODN=0
+13 FOR
SET SDMODN=+$ORDER(SDLIST(SDVP,1,SDMODN))
if 'SDMODN
QUIT
Begin DoDot:1
+14 SET SDMOD=$PIECE(SDLIST(SDVP,1,SDMODN,0),"^")
+15 ;add modifier quantity to array
+16 if SDMOD
SET ^TMP("SCRPW",$JOB,SDIV,1,SDS,"PROC",SDP,SDMOD)=$GET(^TMP("SCRPW",$JOB,SDIV,1,SDS,"PROC",SDP,SDMOD))+SDQ
End DoDot:1
+17 QUIT
+18 ;
CAT(SDS) ;Determine if encounter fits category
+1 ;Required input: SDS array to return list
+2 ;Output: SDS(ifn) array=list of category ifns to tally
+3 IF SD("CAT")="C"
SET SDCL=$PIECE(SDOE0,U,4)
if SDCL<1
QUIT 0
if SD("FMT")="S"!$DATA(SD("LIST",+SDCL))
SET SDS(SDCL)=""
QUIT $DATA(SDS)
+4 IF SD("CAT")="P"
DO CATP
QUIT $DATA(SDS)
+5 IF SD("CAT")="S"
DO CATS
QUIT $DATA(SDS)
+6 QUIT 0
+7 ;
CATP ;Get providers
+1 KILL SDLIST
DO GETPRV^SDOE(SDOE,"SDLIST")
+2 SET SDPI=0
FOR
SET SDPI=$ORDER(SDLIST(SDPI))
if 'SDPI
QUIT
SET SDP=$PIECE(SDLIST(SDPI),U)
if SD("FMT")="S"!$DATA(SD("LIST",SDP))
SET SDS(SDP)=""
+3 QUIT
+4 ;
CATS ;Get stop codes
+1 SET SDSC=+$PIECE(SDOE0,U,3)
if SD("FMT")="S"!$DATA(SD("LIST",SDSC))
SET SDS(SDSC)=""
+2 SET SDCH=0
FOR
SET SDCH=$ORDER(^SCE("APAR",SDOE,SDCH))
if 'SDCH
QUIT
SET SDCH0=$$GETOE^SDOE(SDCH)
IF $PIECE(SDCH0,U,8)=4
SET SDSC=+$PIECE(SDCH0,U,3)
if SD("FMT")="S"!$DATA(SD("LIST",SDSC))
SET SDS(SDSC)=""
+3 QUIT
