Index: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m
===================================================================
--- WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m	(revision 613)
+++ WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m	(revision 623)
@@ -1,102 +1,102 @@
-SDAMODO3	;ALB/SCK - PROVIDER DIAGNOSTICS REPORT OUTPUT ; 05 Oct 98  8:44 PM
-	;;5.3;Scheduling;**11,25,46,49,159,529**;Aug 13, 1993;Build 3
-	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)="XMS",X=DX_" "  ;SD/529
-	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)
+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)
