SDAMODO.m

SDAMODO ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT ;05 Oct 98  8:39 PM

 ;;5.3;Scheduling;**25,132,159,586**;Aug 13, 1993;Build 28

 ;

 ; Reference to $$IMP^ICDEX supported by ICR #5747

 ;

START ;

 N SORT1,SORT2,SDBEG,SDEND,VAUTD,CLINIC,PATN,PROVDR,STOPC,PDIAG

 N ICD10IMPDT S ICD10IMPDT=$$IMP^ICDEX(30) ;SSA ICD-10

 D HOME^%ZIS

SORTS ;

 I '$$RANGE G EXIT

 I (SDBEG<ICD10IMPDT)&(SDEND>=ICD10IMPDT) W !!,$$LINE("Ending Date must be prior to "_$$FMTE^XLFDT(ICD10IMPDT,"5Z")_" for ICD9 diagnosis codes.") G SORTS ;SSA ICD-10

 I '$$DIV G EXIT

 I '$$SORT1 G EXIT

 I '$$SORT2 G EXIT

PICKS ;

 I SORT1=1!(SORT2=1) G EXIT:'$$PROV

 I SORT1=2!(SORT2=2) G EXIT:'$$DIAG

 I SORT1=3!(SORT2=3) G EXIT:'$$PAT

 I SORT1=4!(SORT2=4) G EXIT:'$$CLINIC

 I SORT1=5!(SORT2=5) G EXIT:'$$STOP

FIN ;

 I '$$COMPL G SORTS

PRINT ;

 W !,"This report requires 132 columns for printout"

 S %ZIS="PMQ" D ^%ZIS G EXIT:POP

 I $D(IO("Q")) D QUE  G EXIT

 W ! D WAIT^DICD

 D ^SDAMODO2

EXIT ;

 D:'$D(ZTQUEUED) ^%ZISC

 K VAUTC,VAUTD,VAUTS,DIC,STR,CHECK,VAUTSTR,VAUTVB,X,Y,VAUTNI,SORT1,SORT2,SDEND,SDBEG

 Q

 ;

CLINIC() ;

 W !!,$$LINE("Clinic Selection")

 S DIC="^SC(",VAUTSTR="Clinic",VAUTVB="CLINIC",VAUTNI=2,DIC("S")="I $P(^(0),U,3)[""C"""

 D FIRST^VAUTOMA

 I Y<0 K CLINIC

 Q $D(CLINIC)>0

 ;

STOP() ;

 W !!,$$LINE("Stop Codes Selection")

 S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="STOPC",VAUTNI=2

 D FIRST^VAUTOMA

 I Y<0 K STOPC

 Q $D(STOPC)>0

 ;

PAT() ;

 W !!,$$LINE("Select Patients")

 S DIC="^DPT(",VAUTSTR="Patient",VAUTVB="PATN",VAUTNI=2

 D FIRST^VAUTOMA

 I Y<0 K PATN

 Q $D(PATN)>0

 ;

PROV() ;   select provider

 W !!,$$LINE("Select Providers")

 S DIC="^VA(200,",VAUTSTR="Provider",VAUTVB="PROVDR",VAUTNI=2

 D FIRST^VAUTOMA

 I Y<0 K PROVDR

 Q $D(PROVDR)>0

 ;

DIAG() ;

 ; SSA ICD-10

 W !!,$$LINE("Select Diagnosis Code") S DIC="^ICD9(",VAUTSTR="Diagnosis "_$S(SDBEG<ICD10IMPDT:"(ICD9)",1:"(ICD10)"),VAUTVB="PDIAG",VAUTNI=2

 D FIRST^VAUTOMA

 I Y<0 K PDIAG

 Q $D(PDIAG)>0

 ;

RANGE() ;   select date range for report

 W !!,$$LINE("Date Range Selection")

 Q $$RANGE^SDAMQ(.SDBEG,.SDEND)

 ;

SORT1() ;  first level sort

 W !!,$$LINE("First level sort will be by Division")

 W !,$$LINE("Select Second Sort Level")

 S SORT1=$$OPTIONS(0)

 Q (Y)

 ;

SORT2() ;  second level sort

 W !!,$$LINE("Sorting by Division and "_$P($T(SORT+SORT1^SDAMODO1),";;",2))

 W !,$$LINE("Select Third Sort Level")

 S SORT2=$$OPTIONS(SORT1)

 Q (Y)

 ;

DIV() ;

 W:$P($G(^DG(43,1,"GL")),U,2) !!,$$LINE("Division Selection")

 D ASK2^SDDIV I Y<0 K VAUTD

 Q $D(VAUTD)>0

 ;

COMPL() ;

 I '$$SHOW^SDAMODO1 S Y=0 G COMPLQ

 S DIR(0)="Y",DIR("A")="Continue",DIR("?")="Enter 'Y'es or 'N'o.",DIR("B")="YES" D ^DIR

COMPLQ Q (Y)

 ;

LINE(STR) ;  print display line

 N X

 S:STR]"" STR=" "_STR_" "

 S $P(X,"_",(IOM/2)-($L(STR)/2))=""

 Q X_STR_X

 ;

OPTIONS(CHECK) ;  display options for sorting reports

 S X="S^"

 S X=X_$S(CHECK=1:":[Selected];",1:"1:Provider;")

 ; SSA ICD-10

 I SDBEG<ICD10IMPDT S X=X_$S(CHECK=2:":[Selected];",1:"2:Diagnosis (ICD9) [DX];")

 I SDBEG>=ICD10IMPDT S X=X_$S(CHECK=2:":[Selected];",1:"2:Diagnosis (ICD10) [DX];")

 S X=X_$S(CHECK=3:":[Selected];",1:"3:Patient;")

 S X=X_$S(CHECK=4:":[Selected];",1:"4:Clinic;")

 S X=X_$S(CHECK=5:":[Selected]",1:"5:Primary Stop Code")

 S DIR(0)=X,DIR("A")="Select Sort Option"

 D ^DIR K DIR

 Q (+Y)

 ;

QUE ;

 S ZTRTN="^SDAMODO2",ZTDESC="PROVIDER DX REPORT"

 F X="SORT1","SORT2","SDBEG","SDEND","VAUTD(","CLINIC(","PATN(","PROVDR(","STOPC(","PDIAG(","VAUTD","CLINIC","PATN","PROVDR","STOPC","PDIAG","ICD10IMPDT" S ZTSAVE(X)=""

 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK

 D HOME^%ZIS K IO("Q")

 Q

 ;

ERR ;

 W !!,"NOT AVAILABLE"

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDAMODO   3728     printed  Feb 19, 2025@00:14:21                                                                                                                                                                                                     Page 2

SDAMODO   ;ALB/SCK - PROVIDER DIAGNOSTICS REPORT ;05 Oct 98  8:39 PM

 +1       ;;5.3;Scheduling;**25,132,159,586**;Aug 13, 1993;Build 28

 +2       ;

 +3       ; Reference to $$IMP^ICDEX supported by ICR #5747

 +4       ;

START     ;

 +1        NEW SORT1,SORT2,SDBEG,SDEND,VAUTD,CLINIC,PATN,PROVDR,STOPC,PDIAG

 +2       ;SSA ICD-10

           NEW ICD10IMPDT

           SET ICD10IMPDT=$$IMP^ICDEX(30)

 +3        DO HOME^%ZIS

SORTS     ;

 +1        IF '$$RANGE

               GOTO EXIT

 +2       ;SSA ICD-10

           IF (SDBEG<ICD10IMPDT)&(SDEND>=ICD10IMPDT)

               WRITE !!,$$LINE("Ending Date must be prior to "_$$FMTE^XLFDT(ICD10IMPDT,"5Z")_" for ICD9 diagnosis codes.")

               GOTO SORTS

 +3        IF '$$DIV

               GOTO EXIT

 +4        IF '$$SORT1

               GOTO EXIT

 +5        IF '$$SORT2

               GOTO EXIT

PICKS     ;

 +1        IF SORT1=1!(SORT2=1)

               if '$$PROV

                   GOTO EXIT

 +2        IF SORT1=2!(SORT2=2)

               if '$$DIAG

                   GOTO EXIT

 +3        IF SORT1=3!(SORT2=3)

               if '$$PAT

                   GOTO EXIT

 +4        IF SORT1=4!(SORT2=4)

               if '$$CLINIC

                   GOTO EXIT

 +5        IF SORT1=5!(SORT2=5)

               if '$$STOP

                   GOTO EXIT

FIN       ;

 +1        IF '$$COMPL

               GOTO SORTS

PRINT     ;

 +1        WRITE !,"This report requires 132 columns for printout"

 +2        SET %ZIS="PMQ"

           DO ^%ZIS

           if POP

               GOTO EXIT

 +3        IF $DATA(IO("Q"))

               DO QUE

               GOTO EXIT

 +4        WRITE !

           DO WAIT^DICD

 +5        DO ^SDAMODO2

EXIT      ;

 +1        if '$DATA(ZTQUEUED)

               DO ^%ZISC

 +2        KILL VAUTC,VAUTD,VAUTS,DIC,STR,CHECK,VAUTSTR,VAUTVB,X,Y,VAUTNI,SORT1,SORT2,SDEND,SDBEG

 +3        QUIT 

 +4       ;

CLINIC()  ;

 +1        WRITE !!,$$LINE("Clinic Selection")

 +2        SET DIC="^SC("

           SET VAUTSTR="Clinic"

           SET VAUTVB="CLINIC"

           SET VAUTNI=2

           SET DIC("S")="I $P(^(0),U,3)[""C"""

 +3        DO FIRST^VAUTOMA

 +4        IF Y<0

               KILL CLINIC

 +5        QUIT $DATA(CLINIC)>0

 +6       ;

STOP()    ;

 +1        WRITE !!,$$LINE("Stop Codes Selection")

 +2        SET DIC="^DIC(40.7,"

           SET VAUTSTR="Stop Code"

           SET VAUTVB="STOPC"

           SET VAUTNI=2

 +3        DO FIRST^VAUTOMA

 +4        IF Y<0

               KILL STOPC

 +5        QUIT $DATA(STOPC)>0

 +6       ;

PAT()     ;

 +1        WRITE !!,$$LINE("Select Patients")

 +2        SET DIC="^DPT("

           SET VAUTSTR="Patient"

           SET VAUTVB="PATN"

           SET VAUTNI=2

 +3        DO FIRST^VAUTOMA

 +4        IF Y<0

               KILL PATN

 +5        QUIT $DATA(PATN)>0

 +6       ;

PROV()    ;   select provider

 +1        WRITE !!,$$LINE("Select Providers")

 +2        SET DIC="^VA(200,"

           SET VAUTSTR="Provider"

           SET VAUTVB="PROVDR"

           SET VAUTNI=2

 +3        DO FIRST^VAUTOMA

 +4        IF Y<0

               KILL PROVDR

 +5        QUIT $DATA(PROVDR)>0

 +6       ;

DIAG()    ;

 +1       ; SSA ICD-10

 +2        WRITE !!,$$LINE("Select Diagnosis Code")

           SET DIC="^ICD9("

           SET VAUTSTR="Diagnosis "_$SELECT(SDBEG<ICD10IMPDT:"(ICD9)",1:"(ICD10)")

           SET VAUTVB="PDIAG"

           SET VAUTNI=2

 +3        DO FIRST^VAUTOMA

 +4        IF Y<0

               KILL PDIAG

 +5        QUIT $DATA(PDIAG)>0

 +6       ;

RANGE()   ;   select date range for report

 +1        WRITE !!,$$LINE("Date Range Selection")

 +2        QUIT $$RANGE^SDAMQ(.SDBEG,.SDEND)

 +3       ;

SORT1()   ;  first level sort

 +1        WRITE !!,$$LINE("First level sort will be by Division")

 +2        WRITE !,$$LINE("Select Second Sort Level")

 +3        SET SORT1=$$OPTIONS(0)

 +4        QUIT (Y)

 +5       ;

SORT2()   ;  second level sort

 +1        WRITE !!,$$LINE("Sorting by Division and "_$PIECE($TEXT(SORT+SORT1^SDAMODO1),";;",2))

 +2        WRITE !,$$LINE("Select Third Sort Level")

 +3        SET SORT2=$$OPTIONS(SORT1)

 +4        QUIT (Y)

 +5       ;

DIV()     ;

 +1        if $PIECE($GET(^DG(43,1,"GL")),U,2)

               WRITE !!,$$LINE("Division Selection")

 +2        DO ASK2^SDDIV

           IF Y<0

               KILL VAUTD

 +3        QUIT $DATA(VAUTD)>0

 +4       ;

COMPL()   ;

 +1        IF '$$SHOW^SDAMODO1

               SET Y=0

               GOTO COMPLQ

 +2        SET DIR(0)="Y"

           SET DIR("A")="Continue"

           SET DIR("?")="Enter 'Y'es or 'N'o."

           SET DIR("B")="YES"

           DO ^DIR

COMPLQ     QUIT (Y)

 +1       ;

LINE(STR) ;  print display line

 +1        NEW X

 +2        if STR]""

               SET STR=" "_STR_" "

 +3        SET $PIECE(X,"_",(IOM/2)-($LENGTH(STR)/2))=""

 +4        QUIT X_STR_X

 +5       ;

OPTIONS(CHECK) ;  display options for sorting reports

 +1        SET X="S^"

 +2        SET X=X_$SELECT(CHECK=1:":[Selected];",1:"1:Provider;")

 +3       ; SSA ICD-10

 +4        IF SDBEG<ICD10IMPDT

               SET X=X_$SELECT(CHECK=2:":[Selected];",1:"2:Diagnosis (ICD9) [DX];")

 +5        IF SDBEG>=ICD10IMPDT

               SET X=X_$SELECT(CHECK=2:":[Selected];",1:"2:Diagnosis (ICD10) [DX];")

 +6        SET X=X_$SELECT(CHECK=3:":[Selected];",1:"3:Patient;")

 +7        SET X=X_$SELECT(CHECK=4:":[Selected];",1:"4:Clinic;")

 +8        SET X=X_$SELECT(CHECK=5:":[Selected]",1:"5:Primary Stop Code")

 +9        SET DIR(0)=X

           SET DIR("A")="Select Sort Option"

 +10       DO ^DIR

           KILL DIR

 +11       QUIT (+Y)

 +12      ;

QUE       ;

 +1        SET ZTRTN="^SDAMODO2"

           SET ZTDESC="PROVIDER DX REPORT"

 +2        FOR X="SORT1","SORT2","SDBEG","SDEND","VAUTD(","CLINIC(","PATN(","PROVDR(","STOPC(","PDIAG(","VAUTD","CLINIC","PATN","PROVDR","STOPC","PDIAG","ICD10IMPDT"

               SET ZTSAVE(X)=""

 +3        DO ^%ZTLOAD

           if $DATA(ZTSK)

               WRITE !,"TASK #: ",ZTSK

 +4        DO HOME^%ZIS

           KILL IO("Q")

 +5        QUIT 

 +6       ;

ERR       ;

 +1        WRITE !!,"NOT AVAILABLE"

 +2        QUIT 

 +3       ;