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 ---[H[J[2J[HSDAMODO 3728 printed Dec 13, 2024@02:47:55 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 ;
