SDAMODO3 ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT OUTPUT ; 05 Oct 98 8:44 PM ;;5.3;Scheduling;**11,25,46,49,159**;Aug 13, 1993 Q REPORT ; I '$D(^TMP("SDRPT",$J)) D NOREP G EXIT START ; N SDIV,OEN,SDPRX,SUB1,SUB2,OEN,SDATA,SDX,SPRV,SDCHECK S (SDIV,SDFIN,SDVC,SUBX,SUB1,SUB2)="",(PAGE,QFLAG,SUBCNT)=0 W:$E(IOST,1,2)="C-" @IOF F S SDIV=$O(^TMP("SDRPT",$J,SDIV)) Q:SDIV="" D Q:SDFIN . I SDIV'=SDVC S SUBX=$$SUBCNT(SUB1,SUBX),SDFIN='$$HDR(SDIV) Q:SDFIN S SDVC=SDIV . S SUB1="" F S SUB1=$O(^TMP("SDRPT",$J,SDIV,SUB1)) Q:SUB1="" D Q:SDFIN .. I SUBX'=SUB1 S SUBX=$$SUBCNT(SUB1,SUBX) .. I SORT1=4!(SORT1=5) I SUBX]"",SUBX'=SUB1 S SDFIN='$$HDR(SDIV) .. S SUB2="" F S SUB2=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2)) Q:SUB2="" D Q:SDFIN ... S OEN=0 F S OEN=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN)) Q:'OEN S SUBCNT=SUBCNT+1,SDCHECK="" D Q:SDFIN .... S I=0 F S I=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I)) Q:'I S SDFIN='$$PRNT(I) Q:SDFIN S SUBX=$$SUBCNT(SUB1,SUBX) EXIT ; K QFLAG,PAGE,SDFIN,SDVC,SDONE,XX,^TMP("SDRPT",$J),SUBCNT,SUBX Q ; SUBCNT(SB1,SB1P) ; I SB1P']""!(SUBCNT'>0) G SUBCNTQ W !,SUBCNT," ",$S(SORT2=1!(SORT2=2):"Primary "_$P($T(SORT+SORT2^SDAMODO1),";;",2),1:$P($T(SORT+SORT2^SDAMODO1),";;",2))," entries for ",$S(SORT1=1!(SORT1=3):$P(SB1P,"^"),SORT1=5:$P($G(^DIC(40.7,SB1P,0)),U),1:SB1P),!! S SUBCNT=0 SUBCNTQ Q (SB1) ; PRNT(I) ; N Y,SDATA,SPRV,SDX,XX,SCODE,SDDX1,SDPRX,SDSID S SDATA=(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,0)) S XX="" F S XX=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,"PRV",XX)) Q:'XX S SPRV(XX)="" S XX="" F S XX=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,"DX",XX)) Q:XX="" S SDX(XX)="" I SORT1=1,'$$SELPRV(SUB1) S Y=1 G PRNTQ I SORT1=2,'$$SELDX(SUB1) S Y=1 G PRNTQ I $Y+5>IOSL S Y='$$HDR(SDIV) G:Y PRNTQ LINE1 ; S SDSID=$P($G(SDATA),U,2) W !,$P(^DPT($P($G(SDATA),U),0),U)_" "_$P(SDSID,"-",3) S:SDCHECK="" SDCHECK=SDSID I SDSID'=SDCHECK S SUBCNT=SUBCNT+1 W ?32,$P($$FMTE^XLFDT(OEN,1),":",1,2) ; modified to drop seconds W ?55,$E($P(SDATA,U,3),1,25) W ?90,$S(+$P(SDATA,U,5)>0:$P(^VA(200,+$P(SDATA,U,5),0),U),1:$P(SDATA,U,5)) W ?117,$P(SDATA,U,6) LINE2 ; S SCODE=$P(SDATA,U,4) W !?56,$P($G(^DIC(40.7,+SCODE,0)),U,2),"/",$P($G(^DIC(40.7,+SCODE,0)),U) S SDPRX="",SDPRX=$O(SPRV(SDPRX)) I $D(SDPRX),SORT1'=1 W ?90,$S(+SDPRX>0:$P(^VA(200,SDPRX,0),U),1:"") S SDDX1="",SDDX1=$O(SDX(SDDX1)) I $D(SDDX1),SORT1'=2 W ?117,SDDX1 S SDONE=0 F XX=1:1 D Q:SDONE . I SDDX1'="" S SDDX1=$O(SDX(SDDX1)) . I SDPRX'="" S SDPRX=$O(SPRV(SDPRX)) . I SDPRX']""&(SDDX1']"") S SDONE=1 Q . I $Y+5>IOSL S SDONE='$$HDR(SDIV) Q:SDONE . W ! . I $D(SDPRX),SORT1'=1 W ?90,$S(+SDPRX>0:$P(^VA(200,SDPRX,0),U),1:"") . I $D(SDDX1),SORT1'=2 W ?117,SDDX1 S Y=1 PRNTQ S:QFLAG Y=0 Q (Y) ; HDR(SDIV) ; N Y S Y=0 I SDVC'="",$E(IOST,1,2)="C-" D G:QFLAG HDRQ . K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue or '^' to exit" . S DIR("?",1)="Pressing any key other than the '^' key will scroll to the next screen",DIR("?")="The '^' key will exit the listing." . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QFLAG=1 Q . W @IOF S PAGE=PAGE+1 I $E(IOST,1,2)'="C-",SDVC'="" W @IOF W !!,"Provider/Diagnosis Encounter Report sorted by ",$P($T(SORT+SORT1^SDAMODO1),";;",2)," and ",$P($T(SORT+SORT2^SDAMODO1),";;",2) W ?(IOM-40),"Report Date: ",$P($$NOW^VALM1,"@"),?(IOM-10),"Page: ",PAGE W !,"Inclusion Dates: ",$P($$FMTE^XLFDT(SDBEG,1),"@")," to ",$P($$FMTE^XLFDT(SDEND,1),"@") W !,"Division: ",$P($G(^DG(40.8,SDIV,0)),U) W !!,"PATIENT",?32,"ENCOUNTER DATE",?55,"CLINIC/PRIMARY STOP CODE",?90,"PROVIDER",?117,"DX CODE" W !,"-------------------",?32,"------------------",?55,"------------------------",?90,"--------------",?117,"-------" S Y=1 HDRQ Q (Y) ; NOREP ; W !!,"Provider/Diagnosis Report sorted by ",$P($T(SORT+SORT1^SDAMODO1),";;",2)," and ",$P($T(SORT+SORT2^SDAMODO1),";;",2) W ?(IOM-40),"Report Date: ",$P($$NOW^VALM1,"@") W !,"Inclusion Dates: ",$P($$FMTE^XLFDT(SDBEG,1),"@")," to ",$P($$FMTE^XLFDT(SDEND,1),"@") W !!,"No data found matching sort parameters" Q ; SELPRV(PRV) ; N Y S Y=1 I PROVDR=1 G SELPRVQ I $D(PROVDR($P(PRV,"^",2))) G SELPRVQ S Y=0 SELPRVQ Q (Y) ; SELDX(DX) ; N Y S Y=1 I PDIAG=1 G SELDXQ S DIC="^ICD9(",DIC(0)="MZ",X=DX D ^DIC K DIC I Y<0 S Y=0 G SELDXQ I $D(PDIAG($P(Y,U))) G SELDXQ S Y=0 SELDXQ Q (Y)