SCRPW28 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 12/5/00 4:44pm
 ;;5.3;Scheduling;**144,232**;AUG 13, 1993
PDF ;Print delimited format
 S (SDOUT,SDSTOP)=0 D RPAR,RSUM,RDET G EXIT^SCRPW27
 ;
RPAR W !,$$BRK("Report Parameters") Q:SDOUT
 W !,"TYPE^CATEGORY^SUB-CATEGORY^VALUE^METHOD^INCLUDE/EXCLUDE"
 S SDI=0 F  S SDI=$O(SDPAR("F",SDI)) Q:'SDI  W !,"FORMAT^",$P($T(F+SDI^SCRPW22),";;",2),"^(none)^",$P(SDPAR("F",SDI),U,2),"^^"
 D ITEM("P",1) F SDI=1,2 W !,"LIMITATION^",$P($T(L+SDI^SCRPW22),";;",2),"^(none)^",$P(SDPAR("L",SDI),U,2),"^^"
 S SDI=2 F  S SDI=$O(SDPAR("L",SDI)) Q:'SDI  D ITEM("L",SDI)
 F SDI=1,2 W !,"ORDER^",$P($T(O+SDI^SCRPW22),";;",2),"^(none)^",$P($G(SDPAR("O",SDI)),U,2),"^^"
 F SDI=2,1 S SDII=0 F  S SDII=$O(SDPAR("PF",SDI,SDII)) Q:'SDII  S SDX=SDPAR("PF",SDI,SDII) W !,"ADDL. PRINT FIELD^",$P(SDX,U,2),U,$P(SDX,U,3)
 Q
 ;
ITEM(SDS1,SDS2) ;Print parameter item
 K SD S SD(1)=$S(SDS1="P":"PERSPECTIVE",1:"LIMITATION"),SD(2)=$P(SDPAR(SDS1,SDS2),U,2),SD(3)=$P(SDPAR(SDS1,SDS2,1),U,2) I '$D(SDPAR(SDS1,SDS2,4)) D IPRT Q
 S SD(5)=$P(SDPAR(SDS1,SDS2,2),U,2),SD(6)=$S($P($G(SDPAR(SDS1,SDS2,3)),U)="E":"EXCLUDE",1:"INCLUDE")
 I $G(SDPAR(SDS1,SDS2,6))="D" S SDS3=0 D  Q
 .F  S SDS3=$O(SDPAR(SDS1,SDS2,5,SDS3)) Q:'SDS3  S SD(4)=SDPAR(SDS1,SDS2,5,SDS3) D IPRT
 .Q
 S SDS3="" F  S SDS3=$O(SDPAR(SDS1,SDS2,4,SDS3)) Q:SDS3=""  S SD(4)=SDS3 D IPRT
 Q
 ;
IPRT N SDI W ! F SDI=1:1:6 W $G(SD(SDI)) W:SDI'=6 U ;SD*5.3*232 TEJ- N SDI
 Q
 ;
BRK(SDX) ;Print table break
 D STOP^SCRPW26 Q:SDOUT
 N SDY S SDY="",$P(SDY,"-",(132-$L(SDX)\2))=SDX F  S SDY=SDY_"-" Q:$L(SDY)>131
 Q SDY
 ;
EXT() ;Return external value
 Q $S($G(SDPAR("P",1,6))="D":SDS2,1:SDS1)
 ;
RSUM ;Print report summary
 W !,$$BRK("Report Summary") Q:SDOUT
 W !,$P(SDPAR("P",1,1),U,2),U,"ENCOUNTERS",U,"VISITS",U,"UNIQUES"
 I SDF(2) W U,"PRIOR YEAR ENCOUNTERS",U,"PRIOR YEAR VISITS",U,"PRIOR YEAR UNIQUES",U,"% CHANGE UNIQUES",U,"% CHANGE VISITS",U,"% CHANGE UNIQUES"
 I '$D(^TMP("SCRPW",$J,"RPT",1)) W !,"No data found within selected parameters." Q
 S SDORDV="" F  S SDORDV=$O(^TMP("SCRPW",$J,"MASTER",SDORDV),$S(SDORD="ALP":1,1:-1)) Q:SDORDV=""!SDOUT  D RSUM0
 Q:SDOUT  D RSUM1("TOT",1,1) Q
 ;
RSUM0 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 RSUM1("RPT",SDS1,SDS2)
 Q
 ;
RSUM1(SDRPT,SDS1,SDS2) D STOP Q:SDOUT
 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 SDF(2) 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 SDF(2) F SDI=6,7,8 D CALC(SDI)
 W !,SDX S SDI="" F  S SDI=$O(SDX(SDI)) Q:SDI=""  W U,$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:SDF(1)="S"  S SDS1="" F  S SDS1=$O(^TMP("SCRPW",$J,"RPT",1,SDS1)) Q:SDS1=""!SDOUT  S SDS2="" F  S SDS2=$O(^TMP("SCRPW",$J,"RPT",1,SDS1,SDS2)) Q:SDS2=""!SDOUT  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")
 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 SDX1,SDDSV S SDDSV=$$DSV(SDS2_"^"_SDS1)
 S SDX1=$P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - "_$S(SDF(4)="E":"Encounter",SDF(4)="V":"Visit",1:"Unique patient")_" list" W !,$$BRK(SDX1) Q:SDOUT
 W !,"PATIENT",U,"SSN" I "VE"[SDF(4) W U,"DATE" I SDF(4)="E" W U,"LOCATION"
 K ^TMP("SCRPW",$J,"APFM") S SDAPFM=0 D:$D(SDPAR("PF")) APFH
 S SDPNAM="" F  S SDPNAM=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN)) Q:'DFN!SDOUT  D DPTL1
 Q:'$D(^TMP("SCRPW",$J,"APFM"))
 W !,$$BRK(SDX1_" (LINKED SUB-TABLE)") Q:SDOUT  W !,"LINK^DATA VALUE"
 S SDAPFM=0 F  S SDAPFM=$O(^TMP("SCRPW",$J,"APFM",SDAPFM)) Q:'SDAPFM!SDOUT  S SDX="" F  S SDX=$O(^TMP("SCRPW",$J,"APFM",SDAPFM,SDX)) Q:SDX=""!SDOUT  W !,SDAPFM,U,^TMP("SCRPW",$J,"APFM",SDAPFM,SDX) D STOP
 Q
 ;
STOP S SDSTOP=SDSTOP+1 D:SDSTOP#100=0 STOP^SCRPW26 Q
 ;
DPTL1 I SDF(4)="U" W !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9) D APFP,STOP Q
 S SDT=0 F  S SDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT)) Q:'SDT!SDOUT  D DPTL2
 Q
 ;
DPTL2 I SDF(4)="V" W !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9) S Y=SDT X ^DD("DD") W U,Y D APFP,STOP Q
 S SDDT=0 F  S SDDT=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT)) Q:'SDDT!SDOUT  S SDOE=0 F  S SDOE=$O(^TMP("SCRPW",$J,"DET",SDDSV,SDPNAM,DFN,SDT,SDDT,SDOE)) Q:'SDOE!SDOUT  D DPTL3
 Q
 ;
DPTL3 D STOP 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 !,SDPNAM,U,$P($G(^DPT(DFN,0)),U,9),U,Y,U,SDCL D APFP Q
 ;
DDXP ;Detail dx/procedure lists
 W !,$$BRK($P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - Diagnosis ranking") Q:SDOUT
 W !,"DIAGNOSIS",U,"PRIMARY",U,"SECONDARY",U,"TOTAL"
 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:SDQT=""!(SDCT>SDF(5))!SDOUT  S SDS3="" F  S SDS3=$O(^TMP("SCRPW",$J,"RPTTDX",1,SDS1,SDS2,SDQT,SDS3)) Q:SDS3=""!(SDCT>SDF(5))!SDOUT  D DDXP1
 Q:SDOUT  W !,"TOTAL",U,$J(SDTCT(1),10),U,$J(SDTCT(2),10),U,$J(SDTCT(3),10)
 ;
DAPP W !,$$BRK($P(SDPAR("P",1,1),U,2)_": "_$$EXT()_" - Ambulatory procedure ranking") Q:SDOUT  W !,"PROCEDURES",U,"TOTAL"
 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:SDQT=""!(SDCT>SDF(5))!SDOUT  S SDS3="" F  S SDS3=$O(^TMP("SCRPW",$J,"RPTTAP",1,SDS1,SDS2,SDQT,SDS3)) Q:SDS3=""!(SDCT>SDF(5))!SDOUT  D DAPP1
 Q:SDOUT  W !,"TOTAL",U,$J(SDTCT(1),10)
 Q
 ;
DDXP1 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 !,SDS3,U,$J(SDICT(1),10),U,$J(SDICT(2),10),U,$J(SDICT(3),10) S SDCT=SDCT+1 D STOP Q
 ;
DAPP1 S SDICT(1)=^TMP("SCRPW",$J,"RPTAP",1,SDS1,SDS2,SDS3),SDTCT(1)=$G(SDTCT(1))+SDICT(1)
 W !,SDS3,U,$J(SDICT(1),10) S SDCT=SDCT+1 D STOP Q
 ;
APFH ;Addl. print fields header
 N S1,S2,SDX
 F S1=2,1 S S2=0 F  S S2=$O(SDPAR("PF",S1,S2)) Q:'S2  S SDX=SDPAR("PF",S1,S2) W U,$P(^TMP("SCRPW",$J,"ACT",$P(SDX,U)),T) W:$P(^TMP("SCRPW",$J,"ACT",$P(SDX,U)),T,12) " (LINK)"
 Q
 ;
APFP ;Addl. print fields print
 N S1,S2,SDX,SDACT,SDY,SDOE0
 F S1=2,1 S S2=0 F  S S2=$O(SDPAR("PF",S1,S2)) Q:'S2  S SDY=SDPAR("PF",S1,S2),SDACT=^TMP("SCRPW",$J,"ACT",$P(SDY,U)),SDOE0=$$OE0() K SDX X $P(SDACT,T,7) W U,$$APF()
 Q
 ;
APF() N SDZ S (SDZ,SDX)="" S SDX=$O(SDX(SDX)) Q:'$P(SDACT,T,12) $P(SDX(SDX),U,2)
 S SDAPFM=SDAPFM+1,SDX="" F  S SDX=$O(SDX(SDX)) Q:SDX=""  S ^TMP("SCRPW",$J,"APFM",SDAPFM,SDX)=$P(SDX(SDX),U,2)
 Q SDAPFM
 ;
OE0() ;Get encounter node
 Q:"UV"[SDF(4) U_DFN_U
 Q $$GETOE^SDOE(SDOE)