ADEPQA2 ; IHS/HQT/MJL - REPORT OPTIONS ;07:28 PM [ 03/24/1999 9:04 AM ]
;;6.0;ADE;**15**;APRIL 1999
;
ROPT() ;EP - Returns Report options selection or ^ if timeout or hatout
;First ^ piece is option number, 2d piece is whether output
;template to be attached to PATIENT or DENTAL files
;3rd piece is fields to subtotal by
N DIR,ADEROPT,Y,X
ROP1 K DIR,ADEROPT,Y,X
W !,"You have the following options for displaying this report."
S DIR(0)="S^1:Count Patients;2:Print Dental Record Review for Each Patient"
S DIR(0)=DIR(0)_";3:Count ADA Codes;4:Count Visits;5:Print Visit List"
S DIR("A")="Select Report Option"
D ^DIR
I $$HAT() Q 0
S ADEROPT=Y
I ADEROPT=1!(ADEROPT=2) S $P(ADEROPT,U,2)="PATIENT"
E S $P(ADEROPT,U,2)="DENTAL"
ROP2 ;Prompt for Subtotal fields
K DIR
I "34"[+ADEROPT D G:$$HAT() ROP1
. W !!,"You have the following options for SUBTOTALING your report."
. F D Q:$$HAT() Q:X=""
. . S DIR(0)="SO^1:Location of visit;2:Attending Dentist;3:Hygienist/Therapist"
. . I +ADEROPT=3 S DIR(0)=DIR(0)_";4:Operative Site;5:ADA Procedure Code"
. . S DIR("A")="Select"_$S($P(ADEROPT,U,3)]"":" Another ",1:" ")_"SUBTOTAL"
. . I $P(ADEROPT,U,3)]"" S $P(DIR(0),U)="SOB"
. . D ^DIR
. . I $$HAT() Q
. . I X="" Q
. . I $P(ADEROPT,U,3)="" S $P(ADEROPT,U,3)=Y
. . S:$P(ADEROPT,U,3)'[Y $P(ADEROPT,U,3)=$P(ADEROPT,U,3)_","_Y
Q ADEROPT
;
HAT() I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q 1
Q 0
;
; Now that we know report option, we know which file to attach template
BY ;EP
S BY="["_ADETNAM_"]"
S DIOBEG="D CHK2^ADEPQA4"
I +ADEROPT=1 D
. ;S BY=BY_",@+.01"
. S FLDS="!.01;""PATIENT COUNT"""
. S (FR,TO)=""
. S DIC="^AUPNPAT("
I +ADEROPT=2 D
. S FLDS="S ADEPAT=D0 D EN3^ADERVW"
. S (FR,TO)=""
. S DIC="^AUPNPAT("
. S DHD="@"
I +ADEROPT=3 D
. ; IHS MODIFICATION - RVU's (patch 15)
Z . ;S FLDS="ADA CODE,!.01;""PROCEDURES"",&ADA CODE:ESTIMATED MINUTES;""MINUTES"""
. S FLDS="ADA CODE,!.01;""PROCEDURES"",&ADA CODE:ESTIMATED MINUTES;""MINUTES"",&ADA CODE:RVU (Relative Value Unit);""RVU'S"""
. ; End IHS MODIFICATION -RVU's (patch 15)
. I $P(ADEROPT,U,3)]"" D SUBTOT
. S BY=BY_",ADA CODE,@CODCAL"
. S (FR,TO)=""
. S DIC="^ADEPCD("
I +ADEROPT=4 D
. S FLDS="!.01;""VISIT COUNT"""
. I $P(ADEROPT,U,3)]"" D SUBTOT
. S (FR,TO)=""
. S DIC="^ADEPCD("
I +ADEROPT=5 D
. S FLDS="[ADEPQ-VISLIST]"
. S (FR,TO)=""
. S DIC="^ADEPCD("
Q
;
CODCAL ;EP
;CALLED BY BY SETS ADEY=1 IF D0, D1 IN ADEUTL
S ADEY=0
I '$D(ADEADA(1)) S ADEY=1 Q
I $P(ADEADA(1),U,2)="" S ADEY=1 Q
I $D(^ADEUTL("ADEPQA",$J,D0,D1)) S ADEY=1 Q
Q
;
SUBTOT N ADESORT,ADESORTP,ADEJ
S ADESORT=$P(ADEROPT,U,3)
F ADEJ=1:1:$L(ADESORT,",") S ADESORTP=$P(ADESORT,",",ADEJ) D
. S BY=BY_$S(ADESORTP=1:",+LOCATION",ADESORTP=2:",+REPORTING DENTIST;""ATTENDING DENTIST: """,ADESORTP=3:",+AUXILIARY;""HYGIENIST/THERAPIST: """,1:"") ;Get visit level fields
F ADEJ=1:1:$L(ADESORT,",") S ADESORTP=$P(ADESORT,",",ADEJ) D
. S BY=BY_$S(ADESORTP=4:",ADA CODE,+OPERATIVE SITE:MNEMONIC;""OPERATIVE SITE: """,ADESORTP=5:",ADA CODE,+ADA CODE",1:"") ;Get code level fields
Q
K ADESORT,ADESORTP ;*NE
ADEPQA2 ; IHS/HQT/MJL - REPORT OPTIONS ;07:28 PM [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;**15**;APRIL 1999
+2 ;
ROPT() ;EP - Returns Report options selection or ^ if timeout or hatout
+1 ;First ^ piece is option number, 2d piece is whether output
+2 ;template to be attached to PATIENT or DENTAL files
+3 ;3rd piece is fields to subtotal by
+4 NEW DIR,ADEROPT,Y,X
ROP1 KILL DIR,ADEROPT,Y,X
+1 WRITE !,"You have the following options for displaying this report."
+2 SET DIR(0)="S^1:Count Patients;2:Print Dental Record Review for Each Patient"
+3 SET DIR(0)=DIR(0)_";3:Count ADA Codes;4:Count Visits;5:Print Visit List"
+4 SET DIR("A")="Select Report Option"
+5 DO ^DIR
+6 IF $$HAT()
QUIT 0
+7 SET ADEROPT=Y
+8 IF ADEROPT=1!(ADEROPT=2)
SET $PIECE(ADEROPT,U,2)="PATIENT"
+9 IF '$TEST
SET $PIECE(ADEROPT,U,2)="DENTAL"
ROP2 ;Prompt for Subtotal fields
+1 KILL DIR
+2 IF "34"[+ADEROPT
Begin DoDot:1
+3 WRITE !!,"You have the following options for SUBTOTALING your report."
+4 FOR
Begin DoDot:2
+5 SET DIR(0)="SO^1:Location of visit;2:Attending Dentist;3:Hygienist/Therapist"
+6 IF +ADEROPT=3
SET DIR(0)=DIR(0)_";4:Operative Site;5:ADA Procedure Code"
+7 SET DIR("A")="Select"_$SELECT($PIECE(ADEROPT,U,3)]"":" Another ",1:" ")_"SUBTOTAL"
+8 IF $PIECE(ADEROPT,U,3)]""
SET $PIECE(DIR(0),U)="SOB"
+9 DO ^DIR
+10 IF $$HAT()
QUIT
+11 IF X=""
QUIT
+12 IF $PIECE(ADEROPT,U,3)=""
SET $PIECE(ADEROPT,U,3)=Y
+13 IF $PIECE(ADEROPT,U,3)'[Y
SET $PIECE(ADEROPT,U,3)=$PIECE(ADEROPT,U,3)_","_Y
End DoDot:2
IF $$HAT()
QUIT
IF X=""
QUIT
End DoDot:1
IF $$HAT()
GOTO ROP1
+14 QUIT ADEROPT
+15 ;
HAT() IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT 1
+1 QUIT 0
+2 ;
+3 ; Now that we know report option, we know which file to attach template
BY ;EP
+1 SET BY="["_ADETNAM_"]"
+2 SET DIOBEG="D CHK2^ADEPQA4"
+3 IF +ADEROPT=1
Begin DoDot:1
+4 ;S BY=BY_",@+.01"
+5 SET FLDS="!.01;""PATIENT COUNT"""
+6 SET (FR,TO)=""
+7 SET DIC="^AUPNPAT("
End DoDot:1
+8 IF +ADEROPT=2
Begin DoDot:1
+9 SET FLDS="S ADEPAT=D0 D EN3^ADERVW"
+10 SET (FR,TO)=""
+11 SET DIC="^AUPNPAT("
+12 SET DHD="@"
End DoDot:1
+13 IF +ADEROPT=3
Begin DoDot:1
+14 ; IHS MODIFICATION - RVU's (patch 15)
Z ;S FLDS="ADA CODE,!.01;""PROCEDURES"",&ADA CODE:ESTIMATED MINUTES;""MINUTES"""
+1 SET FLDS="ADA CODE,!.01;""PROCEDURES"",&ADA CODE:ESTIMATED MINUTES;""MINUTES"",&ADA CODE:RVU (Relative Value Unit);""RVU'S"""
+2 ; End IHS MODIFICATION -RVU's (patch 15)
+3 IF $PIECE(ADEROPT,U,3)]""
DO SUBTOT
+4 SET BY=BY_",ADA CODE,@CODCAL"
+5 SET (FR,TO)=""
+6 SET DIC="^ADEPCD("
End DoDot:1
+7 IF +ADEROPT=4
Begin DoDot:1
+8 SET FLDS="!.01;""VISIT COUNT"""
+9 IF $PIECE(ADEROPT,U,3)]""
DO SUBTOT
+10 SET (FR,TO)=""
+11 SET DIC="^ADEPCD("
End DoDot:1
+12 IF +ADEROPT=5
Begin DoDot:1
+13 SET FLDS="[ADEPQ-VISLIST]"
+14 SET (FR,TO)=""
+15 SET DIC="^ADEPCD("
End DoDot:1
+16 QUIT
+17 ;
CODCAL ;EP
+1 ;CALLED BY BY SETS ADEY=1 IF D0, D1 IN ADEUTL
+2 SET ADEY=0
+3 IF '$DATA(ADEADA(1))
SET ADEY=1
QUIT
+4 IF $PIECE(ADEADA(1),U,2)=""
SET ADEY=1
QUIT
+5 IF $DATA(^ADEUTL("ADEPQA",$JOB,D0,D1))
SET ADEY=1
QUIT
+6 QUIT
+7 ;
SUBTOT NEW ADESORT,ADESORTP,ADEJ
+1 SET ADESORT=$PIECE(ADEROPT,U,3)
+2 FOR ADEJ=1:1:$LENGTH(ADESORT,",")
SET ADESORTP=$PIECE(ADESORT,",",ADEJ)
Begin DoDot:1
+3 ;Get visit level fields
SET BY=BY_$SELECT(ADESORTP=1:",+LOCATION",ADESORTP=2:",+REPORTING DENTIST;""ATTENDING DENTIST: """,ADESORTP=3:",+AUXILIARY;""HYGIENIST/THERAPIST: """,1:"")
End DoDot:1
+4 FOR ADEJ=1:1:$LENGTH(ADESORT,",")
SET ADESORTP=$PIECE(ADESORT,",",ADEJ)
Begin DoDot:1
+5 ;Get code level fields
SET BY=BY_$SELECT(ADESORTP=4:",ADA CODE,+OPERATIVE SITE:MNEMONIC;""OPERATIVE SITE: """,ADESORTP=5:",ADA CODE,+ADA CODE",1:"")
End DoDot:1
+6 QUIT
+7 ;*NE
KILL ADESORT,ADESORTP
