Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ADEPQA2

ADEPQA2.m

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