- 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
