Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMODO3.m
r613 r623 1 SDAMODO3 2 ;;5.3;Scheduling;**11,25,46,49,159,529**;Aug 13, 1993;Build33 4 REPORT 5 6 START 7 8 9 10 11 12 13 14 15 16 17 18 19 EXIT 20 21 22 23 SUBCNT(SB1,SB1P) 24 25 26 27 SUBCNTQ 28 29 PRNT(I) 30 31 32 33 34 35 36 37 LINE1 38 39 40 41 42 43 44 45 LINE2 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 PRNTQ 61 62 HDR(SDIV) 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 HDRQ 80 81 NOREP 82 83 84 85 86 87 88 SELPRV(PRV) 89 90 91 92 93 SELPRVQ 94 95 SELDX(DX) 96 97 98 S DIC="^ICD9(",DIC(0)="XMS",X=DX_" " ;SD/529 99 100 101 102 SELDXQ 1 SDAMODO3 ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT OUTPUT ; 05 Oct 98 8:44 PM 2 ;;5.3;Scheduling;**11,25,46,49,159**;Aug 13, 1993 3 Q 4 REPORT ; 5 I '$D(^TMP("SDRPT",$J)) D NOREP G EXIT 6 START ; 7 N SDIV,OEN,SDPRX,SUB1,SUB2,OEN,SDATA,SDX,SPRV,SDCHECK 8 S (SDIV,SDFIN,SDVC,SUBX,SUB1,SUB2)="",(PAGE,QFLAG,SUBCNT)=0 9 W:$E(IOST,1,2)="C-" @IOF 10 F S SDIV=$O(^TMP("SDRPT",$J,SDIV)) Q:SDIV="" D Q:SDFIN 11 . I SDIV'=SDVC S SUBX=$$SUBCNT(SUB1,SUBX),SDFIN='$$HDR(SDIV) Q:SDFIN S SDVC=SDIV 12 . S SUB1="" F S SUB1=$O(^TMP("SDRPT",$J,SDIV,SUB1)) Q:SUB1="" D Q:SDFIN 13 .. I SUBX'=SUB1 S SUBX=$$SUBCNT(SUB1,SUBX) 14 .. I SORT1=4!(SORT1=5) I SUBX]"",SUBX'=SUB1 S SDFIN='$$HDR(SDIV) 15 .. S SUB2="" F S SUB2=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2)) Q:SUB2="" D Q:SDFIN 16 ... S OEN=0 F S OEN=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN)) Q:'OEN S SUBCNT=SUBCNT+1,SDCHECK="" D Q:SDFIN 17 .... S I=0 F S I=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I)) Q:'I S SDFIN='$$PRNT(I) Q:SDFIN 18 S SUBX=$$SUBCNT(SUB1,SUBX) 19 EXIT ; 20 K QFLAG,PAGE,SDFIN,SDVC,SDONE,XX,^TMP("SDRPT",$J),SUBCNT,SUBX 21 Q 22 ; 23 SUBCNT(SB1,SB1P) ; 24 I SB1P']""!(SUBCNT'>0) G SUBCNTQ 25 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),!! 26 S SUBCNT=0 27 SUBCNTQ Q (SB1) 28 ; 29 PRNT(I) ; 30 N Y,SDATA,SPRV,SDX,XX,SCODE,SDDX1,SDPRX,SDSID 31 S SDATA=(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,0)) 32 S XX="" F S XX=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,"PRV",XX)) Q:'XX S SPRV(XX)="" 33 S XX="" F S XX=$O(^TMP("SDRPT",$J,SDIV,SUB1,SUB2,OEN,I,"DX",XX)) Q:XX="" S SDX(XX)="" 34 I SORT1=1,'$$SELPRV(SUB1) S Y=1 G PRNTQ 35 I SORT1=2,'$$SELDX(SUB1) S Y=1 G PRNTQ 36 I $Y+5>IOSL S Y='$$HDR(SDIV) G:Y PRNTQ 37 LINE1 ; 38 S SDSID=$P($G(SDATA),U,2) 39 W !,$P(^DPT($P($G(SDATA),U),0),U)_" "_$P(SDSID,"-",3) 40 S:SDCHECK="" SDCHECK=SDSID I SDSID'=SDCHECK S SUBCNT=SUBCNT+1 41 W ?32,$P($$FMTE^XLFDT(OEN,1),":",1,2) ; modified to drop seconds 42 W ?55,$E($P(SDATA,U,3),1,25) 43 W ?90,$S(+$P(SDATA,U,5)>0:$P(^VA(200,+$P(SDATA,U,5),0),U),1:$P(SDATA,U,5)) 44 W ?117,$P(SDATA,U,6) 45 LINE2 ; 46 S SCODE=$P(SDATA,U,4) 47 W !?56,$P($G(^DIC(40.7,+SCODE,0)),U,2),"/",$P($G(^DIC(40.7,+SCODE,0)),U) 48 S SDPRX="",SDPRX=$O(SPRV(SDPRX)) I $D(SDPRX),SORT1'=1 W ?90,$S(+SDPRX>0:$P(^VA(200,SDPRX,0),U),1:"") 49 S SDDX1="",SDDX1=$O(SDX(SDDX1)) I $D(SDDX1),SORT1'=2 W ?117,SDDX1 50 S SDONE=0 51 F XX=1:1 D Q:SDONE 52 . I SDDX1'="" S SDDX1=$O(SDX(SDDX1)) 53 . I SDPRX'="" S SDPRX=$O(SPRV(SDPRX)) 54 . I SDPRX']""&(SDDX1']"") S SDONE=1 Q 55 . I $Y+5>IOSL S SDONE='$$HDR(SDIV) Q:SDONE 56 . W ! 57 . I $D(SDPRX),SORT1'=1 W ?90,$S(+SDPRX>0:$P(^VA(200,SDPRX,0),U),1:"") 58 . I $D(SDDX1),SORT1'=2 W ?117,SDDX1 59 S Y=1 60 PRNTQ S:QFLAG Y=0 Q (Y) 61 ; 62 HDR(SDIV) ; 63 N Y 64 S Y=0 65 I SDVC'="",$E(IOST,1,2)="C-" D G:QFLAG HDRQ 66 . K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue or '^' to exit" 67 . S DIR("?",1)="Pressing any key other than the '^' key will scroll to the next screen",DIR("?")="The '^' key will exit the listing." 68 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QFLAG=1 Q 69 . W @IOF 70 S PAGE=PAGE+1 71 I $E(IOST,1,2)'="C-",SDVC'="" W @IOF 72 W !!,"Provider/Diagnosis Encounter Report sorted by ",$P($T(SORT+SORT1^SDAMODO1),";;",2)," and ",$P($T(SORT+SORT2^SDAMODO1),";;",2) 73 W ?(IOM-40),"Report Date: ",$P($$NOW^VALM1,"@"),?(IOM-10),"Page: ",PAGE 74 W !,"Inclusion Dates: ",$P($$FMTE^XLFDT(SDBEG,1),"@")," to ",$P($$FMTE^XLFDT(SDEND,1),"@") 75 W !,"Division: ",$P($G(^DG(40.8,SDIV,0)),U) 76 W !!,"PATIENT",?32,"ENCOUNTER DATE",?55,"CLINIC/PRIMARY STOP CODE",?90,"PROVIDER",?117,"DX CODE" 77 W !,"-------------------",?32,"------------------",?55,"------------------------",?90,"--------------",?117,"-------" 78 S Y=1 79 HDRQ Q (Y) 80 ; 81 NOREP ; 82 W !!,"Provider/Diagnosis Report sorted by ",$P($T(SORT+SORT1^SDAMODO1),";;",2)," and ",$P($T(SORT+SORT2^SDAMODO1),";;",2) 83 W ?(IOM-40),"Report Date: ",$P($$NOW^VALM1,"@") 84 W !,"Inclusion Dates: ",$P($$FMTE^XLFDT(SDBEG,1),"@")," to ",$P($$FMTE^XLFDT(SDEND,1),"@") 85 W !!,"No data found matching sort parameters" 86 Q 87 ; 88 SELPRV(PRV) ; 89 N Y S Y=1 90 I PROVDR=1 G SELPRVQ 91 I $D(PROVDR($P(PRV,"^",2))) G SELPRVQ 92 S Y=0 93 SELPRVQ Q (Y) 94 ; 95 SELDX(DX) ; 96 N Y S Y=1 97 I PDIAG=1 G SELDXQ 98 S DIC="^ICD9(",DIC(0)="MZ",X=DX 99 D ^DIC K DIC I Y<0 S Y=0 G SELDXQ 100 I $D(PDIAG($P(Y,U))) G SELDXQ 101 S Y=0 102 SELDXQ Q (Y)
Note:
See TracChangeset
for help on using the changeset viewer.
