ADEPQA4 ; IHS/HQT/MJL - REVIEW PARAMETERS ;08:38 PM [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
;
CHK() ;EP - Returns 1 if user says parameters ok, otw 0
W !
N DIR
K DIR
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to review your search parameters" D ^DIR
I $$HAT^ADEPQA() Q 0
I Y'=1 Q 1
D CHK2
K DIR
W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want continue with this search" D ^DIR
I $$HAT^ADEPQA() Q 0
I Y'=1 Q 0
Q 1
;
CHK2 W !!,"This search includes dental visits which meet the following specifications:",!!
I ADESTP,$D(^DIBT($P(ADESTP,U,2),0)) W !,"Limited to entries in the ",$P(^DIBT($P(ADESTP,U,2),0),U)," Template."
I ADEDATE D
. N Y
. W !,"Limited to visits between "
. S Y=$P(ADEDATE,U,2) X ^DD("DD") W Y
. W " and "
. S Y=$P(ADEDATE,U,3) X ^DD("DD") W Y
I ADEAGE W !,"Limited to patients whose AGE AT TIME OF VISIT was between ",$P(ADEAGE,U,2)," and ",$P(ADEAGE,U,3)," (inclusive)."
I ADEPROV W !,"Limited to the following ATTENDING DENTISTS:",!,?5 D
. N ADEJ
. F ADEJ=1:1:$L($P(ADEPROV,U,2),",") W $P(^DIC(16,$P(^DIC(6,$P($P(ADEPROV,U,2),",",ADEJ),0),U),0),U)," "
I ADEHYG W !,"Limited to the following HYGIENISTS/THERAPISTS:",!,?5 D
. N ADEJ
. F ADEJ=1:1:$L($P(ADEHYG,U,2),",") W $P(^DIC(16,$P(^DIC(6,$P($P(ADEHYG,U,2),",",ADEJ),0),U),0),U)," "
I ADELOC W !,"Limited to the following LOCATIONS:",!,?5 D
. N ADEJ
. F ADEJ=1:1:$L($P(ADELOC,U,2),",") W $P(^DIC(4,$P($P(ADELOC,U,2),",",ADEJ),0),U)," "
;
I ADEADA(1) D
. N ADESCN S ADESCN=ADEADA(1)
. I $P(ADESCN,U,2)]"" W !,"Limited to the following ADA CODES:",!,?5 D
. . N ADEJ
. . F ADEJ=1:1:$L($P(ADESCN,U,2),",") W $P(^AUTTADA($P($P(ADESCN,U,2),",",ADEJ),0),U)," "
. I $P(ADESCN,U,7)]"" W !,"Limited to the following OPERATIVE SITES:",!,?5 D
. . F ADEJ=1:1:$L($P(ADESCN,U,7),",") W $P(^ADEOPS($P($P(ADESCN,U,7),",",ADEJ),88),U)," "
. I $P(ADESCN,U,3)]"" D
. . W !
. . I $P(ADESCN,U,4)]"" W "NOT "
. . W "Followed "
. . I $P(ADESCN,U,6)]"" W "on the SAME Operative Site "
. . I $P(ADESCN,U,5)]"" W "within ",$P(ADESCN,U,5)," days "
. . W "by these ADA CODES: " W !,?5 D
. . . F ADEJ=1:1:$L($P(ADESCN,U,3),",") W $P(^AUTTADA($P($P(ADESCN,U,3),",",ADEJ),0),U)," "
. . W !,"Codes on the same visit ",$S($P(ADESCN,U,8)="Y":"WILL",1:"will NOT")," be included as 'FOLLOWED BY' codes."
Q
K ADESCN ;*NE
ADEPQA4 ; IHS/HQT/MJL - REVIEW PARAMETERS ;08:38 PM [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;
CHK() ;EP - Returns 1 if user says parameters ok, otw 0
+1 WRITE !
+2 NEW DIR
+3 KILL DIR
+4 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you want to review your search parameters"
DO ^DIR
+5 IF $$HAT^ADEPQA()
QUIT 0
+6 IF Y'=1
QUIT 1
+7 DO CHK2
+8 KILL DIR
+9 WRITE !
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you want continue with this search"
DO ^DIR
+10 IF $$HAT^ADEPQA()
QUIT 0
+11 IF Y'=1
QUIT 0
+12 QUIT 1
+13 ;
CHK2 WRITE !!,"This search includes dental visits which meet the following specifications:",!!
+1 IF ADESTP
IF $DATA(^DIBT($PIECE(ADESTP,U,2),0))
WRITE !,"Limited to entries in the ",$PIECE(^DIBT($PIECE(ADESTP,U,2),0),U)," Template."
+2 IF ADEDATE
Begin DoDot:1
+3 NEW Y
+4 WRITE !,"Limited to visits between "
+5 SET Y=$PIECE(ADEDATE,U,2)
XECUTE ^DD("DD")
WRITE Y
+6 WRITE " and "
+7 SET Y=$PIECE(ADEDATE,U,3)
XECUTE ^DD("DD")
WRITE Y
End DoDot:1
+8 IF ADEAGE
WRITE !,"Limited to patients whose AGE AT TIME OF VISIT was between ",$PIECE(ADEAGE,U,2)," and ",$PIECE(ADEAGE,U,3)," (inclusive)."
+9 IF ADEPROV
WRITE !,"Limited to the following ATTENDING DENTISTS:",!,?5
Begin DoDot:1
+10 NEW ADEJ
+11 FOR ADEJ=1:1:$LENGTH($PIECE(ADEPROV,U,2),",")
WRITE $PIECE(^DIC(16,$PIECE(^DIC(6,$PIECE($PIECE(ADEPROV,U,2),",",ADEJ),0),U),0),U)," "
End DoDot:1
+12 IF ADEHYG
WRITE !,"Limited to the following HYGIENISTS/THERAPISTS:",!,?5
Begin DoDot:1
+13 NEW ADEJ
+14 FOR ADEJ=1:1:$LENGTH($PIECE(ADEHYG,U,2),",")
WRITE $PIECE(^DIC(16,$PIECE(^DIC(6,$PIECE($PIECE(ADEHYG,U,2),",",ADEJ),0),U),0),U)," "
End DoDot:1
+15 IF ADELOC
WRITE !,"Limited to the following LOCATIONS:",!,?5
Begin DoDot:1
+16 NEW ADEJ
+17 FOR ADEJ=1:1:$LENGTH($PIECE(ADELOC,U,2),",")
WRITE $PIECE(^DIC(4,$PIECE($PIECE(ADELOC,U,2),",",ADEJ),0),U)," "
End DoDot:1
+18 ;
+19 IF ADEADA(1)
Begin DoDot:1
+20 NEW ADESCN
SET ADESCN=ADEADA(1)
+21 IF $PIECE(ADESCN,U,2)]""
WRITE !,"Limited to the following ADA CODES:",!,?5
Begin DoDot:2
+22 NEW ADEJ
+23 FOR ADEJ=1:1:$LENGTH($PIECE(ADESCN,U,2),",")
WRITE $PIECE(^AUTTADA($PIECE($PIECE(ADESCN,U,2),",",ADEJ),0),U)," "
End DoDot:2
+24 IF $PIECE(ADESCN,U,7)]""
WRITE !,"Limited to the following OPERATIVE SITES:",!,?5
Begin DoDot:2
+25 FOR ADEJ=1:1:$LENGTH($PIECE(ADESCN,U,7),",")
WRITE $PIECE(^ADEOPS($PIECE($PIECE(ADESCN,U,7),",",ADEJ),88),U)," "
End DoDot:2
+26 IF $PIECE(ADESCN,U,3)]""
Begin DoDot:2
+27 WRITE !
+28 IF $PIECE(ADESCN,U,4)]""
WRITE "NOT "
+29 WRITE "Followed "
+30 IF $PIECE(ADESCN,U,6)]""
WRITE "on the SAME Operative Site "
+31 IF $PIECE(ADESCN,U,5)]""
WRITE "within ",$PIECE(ADESCN,U,5)," days "
+32 WRITE "by these ADA CODES: "
WRITE !,?5
Begin DoDot:3
+33 FOR ADEJ=1:1:$LENGTH($PIECE(ADESCN,U,3),",")
WRITE $PIECE(^AUTTADA($PIECE($PIECE(ADESCN,U,3),",",ADEJ),0),U)," "
End DoDot:3
+34 WRITE !,"Codes on the same visit ",$SELECT($PIECE(ADESCN,U,8)="Y":"WILL",1:"will NOT")," be included as 'FOLLOWED BY' codes."
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;*NE
KILL ADESCN
