SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ;03 Aug 98 9:06 PM
;;5.3;Scheduling;**144,593**;AUG 13, 1993;Build 13
PRT ;Print ACRP Ad Hoc Report
D:$E(IOST)="C" DISP0^SCRPW23 S SDOUT=0 G:$P(SDPAR("F",6),U)="F" PFT G PDF^SCRPW28
;
HIN ;Header initialization
D NOW^%DTC S SDHIN=1,Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDPAGE=1,SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDPBDT=$P($G(SDPAR("L",1)),U,2),SDPEDT=$P($G(SDPAR("L",2)),U,2),SDTITLX=$P($G(SDPAR("O",2)),U)
Q
;
PFT ;Print as formatted text
S SDCOL=$S(SDF(2):0,IOM=80:3,1:29) F SDR="RPAR","RPRT","RDET" D @SDR Q:SDOUT
I $E(IOST)="C",'SDOUT D N DIR S DIR(0)="E" D ^DIR
.F Q:$Y>(IOSL-2) W !
.Q
G EXIT
;
PPAR ;Print parameters only
D RPAR K:$D(ZTQUEUED) SDPNOW,SDPAGE,SDLINE,SDPBDT,SDPEDT,SDTITLX Q
;
RPAR ;Print report parameters
D:$E(IOST)'="C" HDR^SCRPW29("Report Parameters Selected") Q:SDOUT D PLIST^SCRPW22((IOM-80\2),$S($E(IOST)="C":15,1:(IOSL-10))) Q
;
RPRT ;Print formatted report
W @IOF N DX,DY S (DX,DY)=0 X SDXY
S SDPAGE=1,SDS1="" D HDR^SCRPW29("Report Summary") Q:SDOUT I '$D(^TMP("SCRPW",$J,"RPT",1)) S SDX="No data found within selected parameters." W !!?(IOM-$L(SDX)\2),SDX S SDOUT=1 Q
D HD1^SCRPW29 S SDORDV=""
F S SDORDV=$O(^TMP("SCRPW",$J,"MASTER",SDORDV),$S(SDORD="ALP":1,1:-1)) Q:SDORDV=""!SDOUT D RPRT0
Q:SDOUT D RPRT1("TOT",1,1) Q
;
RPRT0 S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1)) Q:SDS1=""!SDOUT S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"MASTER",SDORDV,SDS1,SDS2)) Q:SDS2=""!SDOUT D RPRT1("RPT",SDS1,SDS2)
Q
;
RPRT1(SDRPT,SDS1,SDS2) N DIWL,DIWF,SDL2 S DIWL=1 S DIWF="C42|"
K SDX S SDX=$S(SDRPT="TOT":"REPORT TOTAL:",$G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
S SDX(0)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"ENC")),SDX(1)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"VIS")),SDX(2)=+$G(^TMP("SCRPW",$J,SDRPT,1,SDS1,SDS2,"UNI"))
I SDCOL=0 S SDX(3)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"ENC")),SDX(4)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"VIS")),SDX(5)=+$G(^TMP("SCRPW",$J,SDRPT,2,SDS1,SDS2,"UNI"))
I SDCOL=0 F SDI=6,7,8 D CALC(SDI)
D:$Y>(IOSL-6) HDR^SCRPW29("Report Summary"),HD1^SCRPW29 Q:SDOUT
I SDRPT="TOT" W !?(SDCOL),"========================================== ======== ======== ======== " W:SDCOL=0 "======== ======== ======== ======== ======== ========"
K ^UTILITY($J,"W") S X=SDX D ^DIWP
F SDL2=1:1:^UTILITY($J,"W",DIWL) W !?(SDCOL),$E(^UTILITY($J,"W",DIWL,SDL2,0),1,42)
S SDI="" F S SDI=$O(SDX(SDI)) Q:SDI=""!SDOUT W ?(SDCOL+44+(10*SDI)),$S(SDX(SDI)="N/A":$J(SDX(SDI),8),1:$J(SDX(SDI),8,$S(SDI<6:0,SDX(SDI)'<100000:0,SDX(SDI)'<10000:1,1:2)))
Q
;
CALC(SDI) ;Calculate % change
S SDX(SDI)=$S(SDX(SDI-3)<1:"N/A",1:SDX(SDI-6)-SDX(SDI-3)*100/SDX(SDI-3))
;
RDET Q:SDOUT!(SDF(1)="S") S SDS1="" F S SDS1=$O(^TMP("SCRPW",$J,"RPT",1,SDS1)) Q:SDOUT!(SDS1="") S SDS2="" F S SDS2=$O(^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2)) Q:SDOUT!(SDS2="") D RDET1
Q
;
RDET1 S SDENC=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"ENC"),SDVIS=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"VIS"),SDUNI=^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2,"UNI")
S SDPTX(1)="Detail of "_$P(SDPAR("P",1,1),U,2)_": "_$S($G(SDPAR("P",1,6))="D":SDS2,1:SDS1),SDPTX(2)="Encounters: "_SDENC_" Visits: "_SDVIS_" Uniques: "_SDUNI D HDR^SCRPW29("Report Detail"),HD2^SCRPW29 Q:SDOUT
D:"EB"[SDF(3) DPTL Q:SDOUT D:"DB"[SDF(3) DDXP Q
;
DSV(SDPER) ;Encrypt detail sort values
N SDX S SDX=$G(^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))) Q:SDX SDX
S (SDX,^TMP("SCRPW",$J,"DSV",0))=$G(^TMP("SCRPW",$J,"DSV",0))+1
S ^TMP("SCRPW",$J,"DSV",$P(SDPER,U,2),$P(SDPER,U))=SDX Q SDX
;
DPTL ;Detail patient list
N SDDSV S SDDSV=$$DSV(SDS2_"^"_SDS1)
S SDCOL=$S($D(SDPAR("PF")):0,IOM=80:0,1:26) D DPHD^SCRPW29
S SDPNAM="" F S SDPNAM=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM)) Q:SDOUT!(SDPNAM="") S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN)) Q:SDOUT!'DFN D DPTL1
Q
;
DPTL1 S SDI=0 I SDF(4)="U" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+19),SDPNAM,?(SDCOL+51),$P($G(^DPT(DFN,0)),U,9) D APFP^SCRPW29 S SDI=SDI+1 Q
S SDT=0 F S SDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT)) Q:SDOUT!'SDT D DPTL2
Q
;
DPTL2 I SDF(4)="V" D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT W !?(SDCOL+13),SDPNAM,?(SDCOL+45),$P($G(^DPT(DFN,0)),U,9) S Y=SDT X ^DD("DD") W ?(SDCOL+57),Y D APFP^SCRPW29 S SDI=SDI+1 Q
S SDDT=0 F S SDDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT)) Q:SDOUT!'SDDT S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)) Q:SDOUT!'SDOE D DPTL3
Q
;
DPTL3 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DPHD^SCRPW29 Q:SDOUT
S SDCL=^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE),SDCL=$P($G(^SC(SDCL,0)),U),Y=SDDT X ^DD("DD")
W !?(SDCOL),$E(SDPNAM,1,18),?(SDCOL+20),$P($G(^DPT(DFN,0)),U,9) W ?(SDCOL+32),$P(Y,":",1,2),?(SDCOL+52),$E(SDCL,1,28) D APFP^SCRPW29 S SDI=SDI+1 Q
;
DDXP ;Detail dx/procedure lists
I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT G DDXP0
W:SDF(3)="B" !! D DDPH^SCRPW29("D")
DDXP0 I '$D(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2)) W !!,"No diagnoses found for this detail item." G DAPP
K SDTCT S SDQT="",SDCT=0
F S SDQT=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DDXP1
Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT
W !?(SDCOL),"==========================================",?(SDCOL+46),"==========",?(SDCOL+61),"==========",?(SDCOL+76),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+46),$J(SDTCT(1),10),?(SDCOL+61),$J(SDTCT(2),10),?(SDCOL+76),$J(SDTCT(3),10)
;
DAPP I $Y>(IOSL-10) D HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("P") Q:SDOUT G DAPP0
W !! D DDPH^SCRPW29("P")
DAPP0 I '$D(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2)) W !!,"No procedures found for this detail item." Q
K SDTCT S SDQT="",SDCT=0
F S SDQT=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT),-1) Q:SDOUT!(SDQT="")!(SDCT>(SDF(5)-1)) S SDS3="" F S SDS3=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3)) Q:SDOUT!(SDS3="")!(SDCT>(SDF(5)-1)) D DAPP1
Q:SDOUT D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT W !?(SDCOL+13),"======================================",?(SDCOL+56),"==========",!?(SDCOL+13),"TOTAL:",?(SDCOL+56),$J(SDTCT(1),10)
Q
;
DDXP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("D") Q:SDOUT F SDI=1,2,3 S SDICT(SDI)=+$P(^TMP("SCRPW",$J,"RPTDX",1,SDS1,SDS2,SDS3),U,SDI),SDTCT(SDI)=$G(SDTCT(SDI))+SDICT(SDI)
N DIWL,DIWF,SDL2 S DIWL=1 S DIWF="C42|" K ^UTILITY($J,"W") S X=SDS3 D ^DIWP
F SDL2=1:1:^UTILITY($J,"W",DIWL) W !?(SDCOL),$E(^UTILITY($J,"W",DIWL,SDL2,0),1,42)
W ?(SDCOL+46),$J(SDICT(1),10),?(SDCOL+61),$J(SDICT(2),10),?(SDCOL+76),$J(SDICT(3),10) S SDCT=SDCT+1 Q
;
DAPP1 D:$Y>(IOSL-6) HDR^SCRPW29("Report Detail"),HD2^SCRPW29,DDPH^SCRPW29("A") Q:SDOUT S SDICT(1)=^TMP("SCRPW",$J,"RPTAP",1,SDS1,SDS2,SDS3),SDTCT(1)=$G(SDTCT(1))+SDICT(1)
W !?(SDCOL+13),SDS3,?(SDCOL+56),$J(SDICT(1),10) S SDCT=SDCT+1 Q
;
EXIT D DISP0^SCRPW23,KVA^VADPT,KILL^%ZISS S X=IOM X ^%ZOSF("RM")
K %,%DT,%Y,C,DFN,DIC,DIR,DTOUT,DUOUT,I,II,S1,S2,SD,SDA,SDACT,SDATE,SDBOT,SDCL,SDCOL,SDCT,SDDT,SDDV,SDE,SDEDT,SDEF,SDENC,SDEXE,SDF,SDFE,SDFI,SDFL
K SDFOUND,SDH,SDI,SDICT,SDII,SDIRB,SDIRQ,SDISP,SDL,SDLEV,SDLINE,SDLP,SDLR,SDNUL,SDO,SDOE,SDOE0,SDOCH,SDOUT,SDP,SDPAGE,SDPAR,SDPBDT,SDPER,SDPNAM
K SDPNOW,SDPTX,SDQT,SDR,SDR1,SDR2,SDREV,SDRPT,SDS,SDS1,SDS2,SDS3,SDDSC1,SDSC2,SDSEL,SDT,SDTAG,SDTCT,SDTITL,SDTITLX,SDTOP,SDTX,SDTYP,SDU,SDUNI
K SDAPFM,SDD,SDPFL,SDIII,S0,SDLPX,SDHIN,SDV,SDVIS,SDX,SDX1,SDX2,SDY,SDYR,SDZ,T,X,X1,X2,Y,ZTSAVE,SDSTOP,SDXY,SDTEMP,SDRM,D0,DINUM,SDNEW,SDOECH
K SDOECH,SDORD,SDORDV,SDS4,SDTOT,^TMP("SCRPW",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW27 7940 printed Sep 23, 2025@20:19:52 Page 2
SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ;03 Aug 98 9:06 PM
+1 ;;5.3;Scheduling;**144,593**;AUG 13, 1993;Build 13
PRT ;Print ACRP Ad Hoc Report
+1 if $EXTRACT(IOST)="C"
DO DISP0^SCRPW23
SET SDOUT=0
if $PIECE(SDPAR("F",6),U)="F"
GOTO PFT
GOTO PDF^SCRPW28
+2 ;
HIN ;Header initialization
+1 DO NOW^%DTC
SET SDHIN=1
SET Y=%
XECUTE ^DD("DD")
SET SDPNOW=$PIECE(Y,":",1,2)
SET SDPAGE=1
SET SDLINE=""
SET $PIECE(SDLINE,"-",(IOM+1))=""
SET SDPBDT=$PIECE($GET(SDPAR("L",1)),U,2)
SET SDPEDT=$PIECE($GET(SDPAR("L",2)),U,2)
SET SDTITLX=$PIECE($GET(SDPAR("O",2)),U)
+2 QUIT
+3 ;
PFT ;Print as formatted text
+1 SET SDCOL=$SELECT(SDF(2):0,IOM=80:3,1:29)
FOR SDR="RPAR","RPRT","RDET"
DO @SDR
if SDOUT
QUIT
+2 IF $EXTRACT(IOST)="C"
IF 'SDOUT
Begin DoDot:1
+3 FOR
if $Y>(IOSL-2)
QUIT
WRITE !
+4 QUIT
End DoDot:1
NEW DIR
SET DIR(0)="E"
DO ^DIR
+5 GOTO EXIT
+6 ;
PPAR ;Print parameters only
+1 DO RPAR
if $DATA(ZTQUEUED)
KILL SDPNOW,SDPAGE,SDLINE,SDPBDT,SDPEDT,SDTITLX
QUIT
+2 ;
RPAR ;Print report parameters
+1 if $EXTRACT(IOST)'="C"
DO HDR^SCRPW29("Report Parameters Selected")
if SDOUT
QUIT
DO PLIST^SCRPW22((IOM-80\2),$SELECT($EXTRACT(IOST)="C":15,1:(IOSL-10)))
QUIT
+2 ;
RPRT ;Print formatted report
+1 WRITE @IOF
NEW DX,DY
SET (DX,DY)=0
XECUTE SDXY
+2 SET SDPAGE=1
SET SDS1=""
DO HDR^SCRPW29("Report Summary")
if SDOUT
QUIT
IF '$DATA(^TMP("SCRPW",$JOB,"RPT",1))
SET SDX="No data found within selected parameters."
WRITE !!?(IOM-$LENGTH(SDX)\2),SDX
SET SDOUT=1
QUIT
+3 DO HD1^SCRPW29
SET SDORDV=""
+4 FOR
SET SDORDV=$ORDER(^TMP("SCRPW",$JOB,"MASTER",SDORDV),$SELECT(SDORD="ALP":1,1:-1))
if SDORDV=""!SDOUT
QUIT
DO RPRT0
+5 if SDOUT
QUIT
DO RPRT1("TOT",1,1)
QUIT
+6 ;
RPRT0 SET SDS1=""
FOR
SET SDS1=$ORDER(^TMP("SCRPW",$JOB,"MASTER",SDORDV,SDS1))
if SDS1=""!SDOUT
QUIT
SET SDS2=""
FOR
SET SDS2=$ORDER(^TMP("SCRPW",$JOB,"MASTER",SDORDV,SDS1,SDS2))
if SDS2=""!SDOUT
QUIT
DO RPRT1("RPT",SDS1,SDS2)
+1 QUIT
+2 ;
RPRT1(SDRPT,SDS1,SDS2) NEW DIWL,DIWF,SDL2
SET DIWL=1
SET DIWF="C42|"
+1 KILL SDX
SET SDX=$SELECT(SDRPT="TOT":"REPORT TOTAL:",$GET(SDPAR("P",1,6))="D":SDS2,1:SDS1)
+2 SET SDX(0)=+$GET(^TMP("SCRPW",$JOB,SDRPT,1,SDS1,SDS2,"ENC"))
SET SDX(1)=+$GET(^TMP("SCRPW",$JOB,SDRPT,1,SDS1,SDS2,"VIS"))
SET SDX(2)=+$GET(^TMP("SCRPW",$JOB,SDRPT,1,SDS1,SDS2,"UNI"))
+3 IF SDCOL=0
SET SDX(3)=+$GET(^TMP("SCRPW",$JOB,SDRPT,2,SDS1,SDS2,"ENC"))
SET SDX(4)=+$GET(^TMP("SCRPW",$JOB,SDRPT,2,SDS1,SDS2,"VIS"))
SET SDX(5)=+$GET(^TMP("SCRPW",$JOB,SDRPT,2,SDS1,SDS2,"UNI"))
+4 IF SDCOL=0
FOR SDI=6,7,8
DO CALC(SDI)
+5 if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Summary")
DO HD1^SCRPW29
if SDOUT
QUIT
+6 IF SDRPT="TOT"
WRITE !?(SDCOL),"========================================== ======== ======== ======== "
if SDCOL=0
WRITE "======== ======== ======== ======== ======== ========"
+7 KILL ^UTILITY($JOB,"W")
SET X=SDX
DO ^DIWP
+8 FOR SDL2=1:1:^UTILITY($JOB,"W",DIWL)
WRITE !?(SDCOL),$EXTRACT(^UTILITY($JOB,"W",DIWL,SDL2,0),1,42)
+9 SET SDI=""
FOR
SET SDI=$ORDER(SDX(SDI))
if SDI=""!SDOUT
QUIT
WRITE ?(SDCOL+44+(10*SDI)),$SELECT(SDX(SDI)="N/A":$JUSTIFY(SDX(SDI),8),1:$JUSTIFY(SDX(SDI),8,$SELECT(SDI<6:0,SDX(SDI)'<100000:0,SDX(SDI)'<10000:1,1:2)))
+10 QUIT
+11 ;
CALC(SDI) ;Calculate % change
+1 SET SDX(SDI)=$SELECT(SDX(SDI-3)<1:"N/A",1:SDX(SDI-6)-SDX(SDI-3)*100/SDX(SDI-3))
+2 ;
RDET if SDOUT!(SDF(1)="S")
QUIT
SET SDS1=""
FOR
SET SDS1=$ORDER(^TMP("SCRPW",$JOB,"RPT",1,SDS1))
if SDOUT!(SDS1="")
QUIT
SET SDS2=""
FOR
SET SDS2=$ORDER(^TMP("SCRPW",$JOB,"RPT",1,SDS1,SDS2))
if SDOUT!(SDS2="")
QUIT
DO RDET1
+1 QUIT
+2 ;
RDET1 SET SDENC=^TMP("SCRPW",$JOB,"RPT",1,SDS1,SDS2,"ENC")
SET SDVIS=^TMP("SCRPW",$JOB,"RPT",1,SDS1,SDS2,"VIS")
SET SDUNI=^TMP("SCRPW",$JOB,"RPT",1,SDS1,SDS2,"UNI")
+1 SET SDPTX(1)="Detail of "_$PIECE(SDPAR("P",1,1),U,2)_": "_$SELECT($GET(SDPAR("P",1,6))="D":SDS2,1:SDS1)
SET SDPTX(2)="Encounters: "_SDENC_" Visits: "_SDVIS_" Uniques: "_SDUNI
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
if SDOUT
QUIT
+2 if "EB"[SDF(3)
DO DPTL
if SDOUT
QUIT
if "DB"[SDF(3)
DO DDXP
QUIT
+3 ;
DSV(SDPER) ;Encrypt detail sort values
+1 NEW SDX
SET SDX=$GET(^TMP("SCRPW",$JOB,"DSV",$PIECE(SDPER,U,2),$PIECE(SDPER,U)))
if SDX
QUIT SDX
+2 SET (SDX,^TMP("SCRPW",$JOB,"DSV",0))=$GET(^TMP("SCRPW",$JOB,"DSV",0))+1
+3 SET ^TMP("SCRPW",$JOB,"DSV",$PIECE(SDPER,U,2),$PIECE(SDPER,U))=SDX
QUIT SDX
+4 ;
DPTL ;Detail patient list
+1 NEW SDDSV
SET SDDSV=$$DSV(SDS2_"^"_SDS1)
+2 SET SDCOL=$SELECT($DATA(SDPAR("PF")):0,IOM=80:0,1:26)
DO DPHD^SCRPW29
+3 SET SDPNAM=""
FOR
SET SDPNAM=$ORDER(^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM))
if SDOUT!(SDPNAM="")
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM,DFN))
if SDOUT!'DFN
QUIT
DO DPTL1
+4 QUIT
+5 ;
DPTL1 SET SDI=0
IF SDF(4)="U"
if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DPHD^SCRPW29
if SDOUT
QUIT
WRITE !?(SDCOL+19),SDPNAM,?(SDCOL+51),$PIECE($GET(^DPT(DFN,0)),U,9)
DO APFP^SCRPW29
SET SDI=SDI+1
QUIT
+1 SET SDT=0
FOR
SET SDT=$ORDER(^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM,DFN,SDT))
if SDOUT!'SDT
QUIT
DO DPTL2
+2 QUIT
+3 ;
DPTL2 IF SDF(4)="V"
if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DPHD^SCRPW29
if SDOUT
QUIT
WRITE !?(SDCOL+13),SDPNAM,?(SDCOL+45),$PIECE($GET(^DPT(DFN,0)),U,9)
SET Y=SDT
XECUTE ^DD("DD")
WRITE ?(SDCOL+57),Y
DO APFP^SCRPW29
SET SDI=SDI+1
QUIT
+1 SET SDDT=0
FOR
SET SDDT=$ORDER(^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT))
if SDOUT!'SDDT
QUIT
SET SDOE=0
FOR
SET SDOE=$ORDER(^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE))
if SDOUT!'SDOE
QUIT
DO DPTL3
+2 QUIT
+3 ;
DPTL3 if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DPHD^SCRPW29
if SDOUT
QUIT
+1 SET SDCL=^TMP("SCRPW",$JOB,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)
SET SDCL=$PIECE($GET(^SC(SDCL,0)),U)
SET Y=SDDT
XECUTE ^DD("DD")
+2 WRITE !?(SDCOL),$EXTRACT(SDPNAM,1,18),?(SDCOL+20),$PIECE($GET(^DPT(DFN,0)),U,9)
WRITE ?(SDCOL+32),$PIECE(Y,":",1,2),?(SDCOL+52),$EXTRACT(SDCL,1,28)
DO APFP^SCRPW29
SET SDI=SDI+1
QUIT
+3 ;
DDXP ;Detail dx/procedure lists
+1 IF $Y>(IOSL-10)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("D")
if SDOUT
QUIT
GOTO DDXP0
+2 if SDF(3)="B"
WRITE !!
DO DDPH^SCRPW29("D")
DDXP0 IF '$DATA(^TMP("SCRPW",$JOB,"RPTTDX",1,SDS1,SDS2))
WRITE !!,"No diagnoses found for this detail item."
GOTO DAPP
+1 KILL SDTCT
SET SDQT=""
SET SDCT=0
+2 FOR
SET SDQT=$ORDER(^TMP("SCRPW",$JOB,"RPTTDX",1,SDS1,SDS2,SDQT),-1)
if SDOUT!(SDQT="")!(SDCT>(SDF(5)-1))
QUIT
SET SDS3=""
FOR
SET SDS3=$ORDER(^TMP("SCRPW",$JOB,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3))
if SDOUT!(SDS3="")!(SDCT>(SDF(5)-1))
QUIT
DO DDXP1
+3 if SDOUT
QUIT
if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("D")
if SDOUT
QUIT
+4 WRITE !?(SDCOL),"==========================================",?(SDCOL+46),"==========",?(SDCOL+61),"==========",?(SDCOL+76),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+46),$JUSTIFY(SDTCT(1),10),?(SDCOL+61),$JUSTIFY(SDTCT(2),10),?(SDCOL+76),$JUSTIFY(
SDTCT(3),10)
+5 ;
DAPP IF $Y>(IOSL-10)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("P")
if SDOUT
QUIT
GOTO DAPP0
+1 WRITE !!
DO DDPH^SCRPW29("P")
DAPP0 IF '$DATA(^TMP("SCRPW",$JOB,"RPTTAP",1,SDS1,SDS2))
WRITE !!,"No procedures found for this detail item."
QUIT
+1 KILL SDTCT
SET SDQT=""
SET SDCT=0
+2 FOR
SET SDQT=$ORDER(^TMP("SCRPW",$JOB,"RPTTAP",1,SDS1,SDS2,SDQT),-1)
if SDOUT!(SDQT="")!(SDCT>(SDF(5)-1))
QUIT
SET SDS3=""
FOR
SET SDS3=$ORDER(^TMP("SCRPW",$JOB,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3))
if SDOUT!(SDS3="")!(SDCT>(SDF(5)-1))
QUIT
DO DAPP1
+3 if SDOUT
QUIT
if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("A")
if SDOUT
QUIT
WRITE !?(SDCOL+13),"======================================",?(SDCOL+56),"==========",!?(SDCOL+13),"TOTAL:",?(SDCOL+56),$JUSTIFY(SDTCT(1),10)
+4 QUIT
+5 ;
DDXP1 if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("D")
if SDOUT
QUIT
FOR SDI=1,2,3
SET SDICT(SDI)=+$PIECE(^TMP("SCRPW",$JOB,"RPTDX",1,SDS1,SDS2,SDS3),U,SDI)
SET SDTCT(SDI)=$GET(SDTCT(SDI))+SDICT(SDI)
+1 NEW DIWL,DIWF,SDL2
SET DIWL=1
SET DIWF="C42|"
KILL ^UTILITY($JOB,"W")
SET X=SDS3
DO ^DIWP
+2 FOR SDL2=1:1:^UTILITY($JOB,"W",DIWL)
WRITE !?(SDCOL),$EXTRACT(^UTILITY($JOB,"W",DIWL,SDL2,0),1,42)
+3 WRITE ?(SDCOL+46),$JUSTIFY(SDICT(1),10),?(SDCOL+61),$JUSTIFY(SDICT(2),10),?(SDCOL+76),$JUSTIFY(SDICT(3),10)
SET SDCT=SDCT+1
QUIT
+4 ;
DAPP1 if $Y>(IOSL-6)
DO HDR^SCRPW29("Report Detail")
DO HD2^SCRPW29
DO DDPH^SCRPW29("A")
if SDOUT
QUIT
SET SDICT(1)=^TMP("SCRPW",$JOB,"RPTAP",1,SDS1,SDS2,SDS3)
SET SDTCT(1)=$GET(SDTCT(1))+SDICT(1)
+1 WRITE !?(SDCOL+13),SDS3,?(SDCOL+56),$JUSTIFY(SDICT(1),10)
SET SDCT=SDCT+1
QUIT
+2 ;
EXIT DO DISP0^SCRPW23
DO KVA^VADPT
DO KILL^%ZISS
SET X=IOM
XECUTE ^%ZOSF("RM")
+1 KILL %,%DT,%Y,C,DFN,DIC,DIR,DTOUT,DUOUT,I,II,S1,S2,SD,SDA,SDACT,SDATE,SDBOT,SDCL,SDCOL,SDCT,SDDT,SDDV,SDE,SDEDT,SDEF,SDENC,SDEXE,SDF,SDFE,SDFI,SDFL
+2 KILL SDFOUND,SDH,SDI,SDICT,SDII,SDIRB,SDIRQ,SDISP,SDL,SDLEV,SDLINE,SDLP,SDLR,SDNUL,SDO,SDOE,SDOE0,SDOCH,SDOUT,SDP,SDPAGE,SDPAR,SDPBDT,SDPER,SDPNAM
+3 KILL SDPNOW,SDPTX,SDQT,SDR,SDR1,SDR2,SDREV,SDRPT,SDS,SDS1,SDS2,SDS3,SDDSC1,SDSC2,SDSEL,SDT,SDTAG,SDTCT,SDTITL,SDTITLX,SDTOP,SDTX,SDTYP,SDU,SDUNI
+4 KILL SDAPFM,SDD,SDPFL,SDIII,S0,SDLPX,SDHIN,SDV,SDVIS,SDX,SDX1,SDX2,SDY,SDYR,SDZ,T,X,X1,X2,Y,ZTSAVE,SDSTOP,SDXY,SDTEMP,SDRM,D0,DINUM,SDNEW,SDOECH
+5 KILL SDOECH,SDORD,SDORDV,SDS4,SDTOT,^TMP("SCRPW",$JOB)
+6 QUIT
