- SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98 9:06 PM
- ;;5.3;Scheduling;**144,1015**;AUG 13, 1993;Build 21
- 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) 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 "======== ======== ======== ======== ======== ========"
- W !?(SDCOL),$E(SDX,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+40),"==========",?(SDCOL+55),"==========",?(SDCOL+70),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+40),$J(SDTCT(1),10),?(SDCOL+55),$J(SDTCT(2),10),?(SDCOL+70),$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)
- W !?(SDCOL),SDS3,?(SDCOL+40),$J(SDICT(1),10),?(SDCOL+55),$J(SDICT(2),10),?(SDCOL+70),$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
- SCRPW27 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98 9:06 PM
- +1 ;;5.3;Scheduling;**144,1015**;AUG 13, 1993;Build 21
- 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) KILL SDX
- SET SDX=$SELECT(SDRPT="TOT":"REPORT TOTAL:",$GET(SDPAR("P",1,6))="D":SDS2,1:SDS1)
- +1 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"))
- +2 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"))
- +3 IF SDCOL=0
- FOR SDI=6,7,8
- DO CALC(SDI)
- +4 IF $Y>(IOSL-6)
- DO HDR^SCRPW29("Report Summary")
- DO HD1^SCRPW29
- IF SDOUT
- QUIT
- +5 IF SDRPT="TOT"
- WRITE !?(SDCOL),"========================================== ======== ======== ======== "
- IF SDCOL=0
- WRITE "======== ======== ======== ======== ======== ========"
- +6 WRITE !?(SDCOL),$EXTRACT(SDX,1,42)
- 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)))
- +7 QUIT
- +8 ;
- 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+40),"==========",?(SDCOL+55),"==========",?(SDCOL+70),"==========",!?(SDCOL),"TOTAL:",?(SDCOL+40),$JUSTIFY(SDTCT(1),10),?(SDCOL+55),$JUSTIFY(SDTCT(2),10),?(SDCOL+70),$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 WRITE !?(SDCOL),SDS3,?(SDCOL+40),$JUSTIFY(SDICT(1),10),?(SDCOL+55),$JUSTIFY(SDICT(2),10),?(SDCOL+70),$JUSTIFY(SDICT(3),10)
- SET SDCT=SDCT+1
- QUIT
- +2 ;
- 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
