ADEPQA3.m

ADEPQA3 ; IHS/HQT/MJL - SEARCH PARAMS ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;**11**;JAN 15, 2002

 ;IHS/HMW

 ;Functions to set up search parameters

 ;

PROV() ;EP - Returns "1/0^dfn,dfn,dfn" where dfn is dfn in provider file

 N DIR,ADEPRV,ADEFLG,DIC,ADEJ,ADEK,ADEY

PRV1 S ADEPRV=""

 K DIR W ! S DIR("A")="Limit search to specific ATTENDING DENTIST(S)"

 S DIR(0)="Y",DIR("B")="NO" D ^DIR

 I $$HAT()!(Y=0) Q 0

 K DIC

 S DIC="^DIC(6,",DIC(0)="AQEM"

 S DIC("S")="I $P(^DIC(6,Y,0),U,4)]"""",$D(^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=52"

 F ADEJ=1:1 S DIC("A")="Select "_$S(ADEPRV]"":"ANOTHER ",1:"")_"Attending Dentist: " D ^DIC Q:X=""  Q:$$HAT()  S ADEY=$P(Y,U,2) D

 . S ADEFLG=0 F ADEK=1:1:$L(ADEPRV,",") I $P(ADEPRV,",",ADEK)=ADEY S ADEFLG=1 Q

 . Q:ADEFLG

 . I ADEPRV]"" S $P(ADEPRV,",",$L(ADEPRV,",")+1)=ADEY Q

 . S ADEPRV=ADEY

 I $$HAT() G PRV1

 I ADEPRV="" G PRV1

 Q "1^"_ADEPRV

 ;

HYG() ;EP - Returns "1/0^dfn,dfn,dfn" where dfn is dfn in provider file

 N DIR,ADEPRV,ADEFLG,DIC,ADEJ,ADEY,ADEK

HYG1 S ADEPRV=""

 K DIR W ! S DIR("A")="Limit search to specific HYGIENIST/THERAPIST(S)"

 S DIR(0)="Y",DIR("B")="NO" D ^DIR

 I $$HAT()!(Y=0) Q 0

 K DIC

 S DIC="^DIC(6,",DIC(0)="AQEM"

 S DIC("S")="I $P(^DIC(6,Y,0),U,4)]"""",$D(^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=46"

 F ADEJ=1:1 S DIC("A")="Select "_$S(ADEPRV]"":"ANOTHER ",1:"")_"Hygienist/Therapist: " D ^DIC Q:X=""  Q:$$HAT()  S ADEY=$P(Y,U,2) D

 . S ADEFLG=0 F ADEK=1:1:$L(ADEPRV,",") I $P(ADEPRV,",",ADEK)=ADEY S ADEFLG=1 Q

 . Q:ADEFLG

 . I ADEPRV]"" S $P(ADEPRV,",",$L(ADEPRV,",")+1)=ADEY Q

 . S ADEPRV=ADEY

 I $$HAT() G HYG1

 I ADEPRV="" G HYG1

 Q "1^"_ADEPRV

 ;

STP() ;EP - Returns "1/0^Search Template DFN^file it's attached to"

 N DIR

STP1 K DIR W ! S DIR("A")="Limit search to entries in one of your Search Templates"

 S DIR(0)="Y",DIR("B")="NO" D ^DIR

 I $$HAT()!(X="")!(Y=0) Q 0

 K DIC S DIC(0)="AQEM",DIC="^DIBT(",DIC("A")="Select SEARCH TEMPLATE: "

 S DIC("S")="I $P(^DIBT(Y,0),U,5)=DUZ I $P(^DIBT(Y,0),U)'[""ADEQA"" I $P(^DIBT(Y,0),U,4)]"""" I $P(^DIBT(Y,0),U,4)=9000001!($P(^DIBT(Y,0),U,4)=9002007)"

 D ^DIC

 I $$HAT()!(X="")!(Y=-1) G STP1

 Q "1^"_+Y_U_$P(^DIBT(+Y,0),U,4)

 ;

DATE() ;EP - Returns "1 or 0^Begin^End" where first piece is 1 if a

 ;date limited search is requested

 N DIR,ADEBEG,X,Y,ADEND

DAT1 W !,"The report will cover the following time period:"

 W ! S DIR("A")="Start with (and include) DATE: "

 S DIR(0)="DA^2810101:"_DT_":EX"

 D ^DIR

 Q:$$HAT() 0

 S ADEBEG=Y

 S DIR("A")="Go to (and include) DATE: "

 S DIR(0)="DA^"_ADEBEG_":"_DT_":EX"

 D ^DIR

 G:$$HAT() DAT1

 S ADEND=Y

 ;IHS/ANMC/HMW 8-14-2002 **11** Added next 2 lines

 S ADEBEG=ADEBEG-1_".9999"

 S ADEND=ADEND_".9999"

 Q "1^"_ADEBEG_U_ADEND

AGE() ;EP - Returns "1or0^Begin^end" where first piece=1 if age search

 N DIR,ADEBEG,X,Y,ADEND

AGE1 W ! S DIR("A")="Do you want to limit the search according to AGE AT TIME OF VISIT"

 S DIR("B")="NO"

 S DIR(0)="Y" D ^DIR

 I $$HAT() Q 0

 I Y=0 Q 0

AGE2 K DIR

 S DIR("A")="Start with (and include) AGE: "

 S DIR(0)="NA^0:110:0"

 D ^DIR

 I $$HAT()!($D(DIRUT)) G AGE1

 S ADEBEG=Y

 S DIR("A")="Go to (and include) AGE: "

 S DIR(0)="NA^"_ADEBEG_":110:0"

 D ^DIR

 I $$HAT()!($D(DIRUT)) W ! G AGE2

 S ADEND=Y

 Q "1^"_ADEBEG_U_ADEND

 ;

HAT() ;EP

 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q 1

 Q 0

LOC() ;EP - Returns "1/0^location1,location2...locationn" where Location is

 ;a location in Local Facilities subfile of DENTAL SITE PARAM

 N ADEFAC,DIR,ADELOC,ADEJ,ADEY,ADEK,ADEFLG

LOC1 S ADEFAC=""

 W ! S DIR("A")="Do you want to limit the search to visits at a particular FACILITY" S DIR("B")="NO"

 S DIR(0)="Y" D ^DIR

 I $$HAT() Q 0

 I Y=0 Q 0

 S ADELOC=$O(^ADEPARAM(0)) Q:'+ADELOC 0  ;FHL 9/9/98;Add message if no DSP entry

 K DIR

 S DIR(0)="PO^ADEPARAM(ADELOC,1,:QEM"

 S DIR("A")="Select Facility"

 F ADEJ=1:1 D ^DIR Q:X=""  Q:$$HAT()  S ADEY=$P(Y,U,2) D

 . S ADEFLG=0 F ADEK=1:1:$L(ADEFAC,",") I $P(ADEFAC,",",ADEK)=ADEY S ADEFLG=1 Q

 . S:'ADEFLG $P(ADEFAC,",",ADEJ)=ADEY

 I $$HAT() K DIR G LOC1

 I ADEFAC="" Q 0

 Q "1^"_ADEFAC

ADEPQA3   ; IHS/HQT/MJL - SEARCH PARAMS ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;**11**;JAN 15, 2002

 +2       ;IHS/HMW

 +3       ;Functions to set up search parameters

 +4       ;

PROV()    ;EP - Returns "1/0^dfn,dfn,dfn" where dfn is dfn in provider file

 +1        NEW DIR,ADEPRV,ADEFLG,DIC,ADEJ,ADEK,ADEY

PRV1       SET ADEPRV=""

 +1        KILL DIR

           WRITE !

           SET DIR("A")="Limit search to specific ATTENDING DENTIST(S)"

 +2        SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

 +3        IF $$HAT()!(Y=0)

               QUIT 0

 +4        KILL DIC

 +5        SET DIC="^DIC(6,"

           SET DIC(0)="AQEM"

 +6        SET DIC("S")="I $P(^DIC(6,Y,0),U,4)]"""",$D(^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=52"

 +7        FOR ADEJ=1:1

               SET DIC("A")="Select "_$SELECT(ADEPRV]"":"ANOTHER ",1:"")_"Attending Dentist: "

               DO ^DIC

               IF X=""

                   QUIT 

               IF $$HAT()

                   QUIT 

               SET ADEY=$PIECE(Y,U,2)

               Begin DoDot:1

 +8                SET ADEFLG=0

                   FOR ADEK=1:1:$LENGTH(ADEPRV,",")

                       IF $PIECE(ADEPRV,",",ADEK)=ADEY

                           SET ADEFLG=1

                           QUIT 

 +9                IF ADEFLG

                       QUIT 

 +10               IF ADEPRV]""

                       SET $PIECE(ADEPRV,",",$LENGTH(ADEPRV,",")+1)=ADEY

                       QUIT 

 +11               SET ADEPRV=ADEY

               End DoDot:1

 +12       IF $$HAT()

               GOTO PRV1

 +13       IF ADEPRV=""

               GOTO PRV1

 +14       QUIT "1^"_ADEPRV

 +15      ;

HYG()     ;EP - Returns "1/0^dfn,dfn,dfn" where dfn is dfn in provider file

 +1        NEW DIR,ADEPRV,ADEFLG,DIC,ADEJ,ADEY,ADEK

HYG1       SET ADEPRV=""

 +1        KILL DIR

           WRITE !

           SET DIR("A")="Limit search to specific HYGIENIST/THERAPIST(S)"

 +2        SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

 +3        IF $$HAT()!(Y=0)

               QUIT 0

 +4        KILL DIC

 +5        SET DIC="^DIC(6,"

           SET DIC(0)="AQEM"

 +6        SET DIC("S")="I $P(^DIC(6,Y,0),U,4)]"""",$D(^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,Y,0),U,4),9999999)=46"

 +7        FOR ADEJ=1:1

               SET DIC("A")="Select "_$SELECT(ADEPRV]"":"ANOTHER ",1:"")_"Hygienist/Therapist: "

               DO ^DIC

               IF X=""

                   QUIT 

               IF $$HAT()

                   QUIT 

               SET ADEY=$PIECE(Y,U,2)

               Begin DoDot:1

 +8                SET ADEFLG=0

                   FOR ADEK=1:1:$LENGTH(ADEPRV,",")

                       IF $PIECE(ADEPRV,",",ADEK)=ADEY

                           SET ADEFLG=1

                           QUIT 

 +9                IF ADEFLG

                       QUIT 

 +10               IF ADEPRV]""

                       SET $PIECE(ADEPRV,",",$LENGTH(ADEPRV,",")+1)=ADEY

                       QUIT 

 +11               SET ADEPRV=ADEY

               End DoDot:1

 +12       IF $$HAT()

               GOTO HYG1

 +13       IF ADEPRV=""

               GOTO HYG1

 +14       QUIT "1^"_ADEPRV

 +15      ;

STP()     ;EP - Returns "1/0^Search Template DFN^file it's attached to"

 +1        NEW DIR

STP1       KILL DIR

           WRITE !

           SET DIR("A")="Limit search to entries in one of your Search Templates"

 +1        SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

 +2        IF $$HAT()!(X="")!(Y=0)

               QUIT 0

 +3        KILL DIC

           SET DIC(0)="AQEM"

           SET DIC="^DIBT("

           SET DIC("A")="Select SEARCH TEMPLATE: "

 +4        SET DIC("S")="I $P(^DIBT(Y,0),U,5)=DUZ I $P(^DIBT(Y,0),U)'[""ADEQA"" I $P(^DIBT(Y,0),U,4)]"""" I $P(^DIBT(Y,0),U,4)=9000001!($P(^DIBT(Y,0),U,4)=9002007)"

 +5        DO ^DIC

 +6        IF $$HAT()!(X="")!(Y=-1)

               GOTO STP1

 +7        QUIT "1^"_+Y_U_$PIECE(^DIBT(+Y,0),U,4)

 +8       ;

DATE()    ;EP - Returns "1 or 0^Begin^End" where first piece is 1 if a

 +1       ;date limited search is requested

 +2        NEW DIR,ADEBEG,X,Y,ADEND

DAT1       WRITE !,"The report will cover the following time period:"

 +1        WRITE !

           SET DIR("A")="Start with (and include) DATE: "

 +2        SET DIR(0)="DA^2810101:"_DT_":EX"

 +3        DO ^DIR

 +4        IF $$HAT()

               QUIT 0

 +5        SET ADEBEG=Y

 +6        SET DIR("A")="Go to (and include) DATE: "

 +7        SET DIR(0)="DA^"_ADEBEG_":"_DT_":EX"

 +8        DO ^DIR

 +9        IF $$HAT()

               GOTO DAT1

 +10       SET ADEND=Y

 +11      ;IHS/ANMC/HMW 8-14-2002 **11** Added next 2 lines

 +12       SET ADEBEG=ADEBEG-1_".9999"

 +13       SET ADEND=ADEND_".9999"

 +14       QUIT "1^"_ADEBEG_U_ADEND

AGE()     ;EP - Returns "1or0^Begin^end" where first piece=1 if age search

 +1        NEW DIR,ADEBEG,X,Y,ADEND

AGE1       WRITE !

           SET DIR("A")="Do you want to limit the search according to AGE AT TIME OF VISIT"

 +1        SET DIR("B")="NO"

 +2        SET DIR(0)="Y"

           DO ^DIR

 +3        IF $$HAT()

               QUIT 0

 +4        IF Y=0

               QUIT 0

AGE2       KILL DIR

 +1        SET DIR("A")="Start with (and include) AGE: "

 +2        SET DIR(0)="NA^0:110:0"

 +3        DO ^DIR

 +4        IF $$HAT()!($DATA(DIRUT))

               GOTO AGE1

 +5        SET ADEBEG=Y

 +6        SET DIR("A")="Go to (and include) AGE: "

 +7        SET DIR(0)="NA^"_ADEBEG_":110:0"

 +8        DO ^DIR

 +9        IF $$HAT()!($DATA(DIRUT))

               WRITE !

               GOTO AGE2

 +10       SET ADEND=Y

 +11       QUIT "1^"_ADEBEG_U_ADEND

 +12      ;

HAT()     ;EP

 +1        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

               QUIT 1

 +2        QUIT 0

LOC()     ;EP - Returns "1/0^location1,location2...locationn" where Location is

 +1       ;a location in Local Facilities subfile of DENTAL SITE PARAM

 +2        NEW ADEFAC,DIR,ADELOC,ADEJ,ADEY,ADEK,ADEFLG

LOC1       SET ADEFAC=""

 +1        WRITE !

           SET DIR("A")="Do you want to limit the search to visits at a particular FACILITY"

           SET DIR("B")="NO"

 +2        SET DIR(0)="Y"

           DO ^DIR

 +3        IF $$HAT()

               QUIT 0

 +4        IF Y=0

               QUIT 0

 +5       ;FHL 9/9/98;Add message if no DSP entry

           SET ADELOC=$ORDER(^ADEPARAM(0))

           IF '+ADELOC

               QUIT 0

 +6        KILL DIR

 +7        SET DIR(0)="PO^ADEPARAM(ADELOC,1,:QEM"

 +8        SET DIR("A")="Select Facility"

 +9        FOR ADEJ=1:1

               DO ^DIR

               IF X=""

                   QUIT 

               IF $$HAT()

                   QUIT 

               SET ADEY=$PIECE(Y,U,2)

               Begin DoDot:1

 +10               SET ADEFLG=0

                   FOR ADEK=1:1:$LENGTH(ADEFAC,",")

                       IF $PIECE(ADEFAC,",",ADEK)=ADEY

                           SET ADEFLG=1

                           QUIT 

 +11               IF 'ADEFLG

                       SET $PIECE(ADEFAC,",",ADEJ)=ADEY

               End DoDot:1

 +12       IF $$HAT()

               KILL DIR

               GOTO LOC1

 +13       IF ADEFAC=""

               QUIT 0

 +14       QUIT "1^"_ADEFAC