AMHRP9.m

AMHRP9 ; IHS/CMI/LAB - SEEN > N TIMES ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

START ;

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 W "**********  PATIENTS SEEN AT LEAST N NUMBER OF TIMES  **********",!!

 W "This report will produce a list of patients who have been seen at least",!," N number of times in a date range specified by the user.",!

 D DBHUSRP^AMHUTIL

 D DBHUSR^AMHUTIL

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range during which the patient should be seen.",!

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AMHED=Y

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

 ;

NUM ;

 S DIR(0)="N^2:100:0",DIR("A")="Enter the minimum number of times the patient should have been seen" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) GETDATES

 G:Y="" GETDATES

 S AMHNUM=+Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G NUM

ZIS ;

 S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 I $G(Y)="B" D BROWSE,XIT Q

 S XBRC="PROC^AMHRP9",XBRP="^AMHRP9P",XBNS="AMH",XBRX="XIT^AMHRP9"

 D ^XBDBQUE

XIT K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHNUM,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHFOUN,AMHPOV,AMHRA,AMHRX,AMHRY

 K AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP

 Q

BROWSE ;

 S XBRP="VIEWR^XBLM(""^AMHRP9P"")"

 S XBNS="AMH",XBRC="PROC^AMHRP9",XBRX="XIT^AMHRP9",XBIOP=0 D ^XBDBQUE

 Q

 ;

PROC ;EP - entry point for processing

 S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,DFN=0,AMHBT=$H

 D XTMP^AMHUTIL("AMHRP9","BH - PTS WITH N VISITS")

 F  S DFN=$O(^AMHREC("AE",DFN)) Q:DFN'=+DFN  I $$ALLOWP^AMHUTIL(DUZ,DFN) D PROC1

 S AMHET=$H

 K DFN

 Q

PROC1 ;

 Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))

VSTS ; process visits

 S AMHR=0,AMHBDO=9999999-AMHBD,AMHEDO=9999999-AMHED,AMHSD=AMHED-1,AMHSD=AMHSD_".9999",AMHRCNT=0

 F  S AMHSD=$O(^AMHREC("AE",DFN,AMHSD)) Q:$P(AMHSD,".")>AMHBDO!(AMHSD="")  D

 .S AMHR=0 F  S AMHR=$O(^AMHREC("AE",DFN,AMHSD,AMHR)) Q:AMHR'=+AMHR  D

 ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)

 ..S AMHRCNT=AMHRCNT+1 ;COUNT # VISITS

 .Q

 I AMHRCNT'<AMHNUM S ^XTMP("AMHRP9",AMHJOB,AMHBTH,$P(^DPT(DFN,0),U),DFN)=""

 Q

 ;

AMHRP9    ; IHS/CMI/LAB - SEEN > N TIMES ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

START     ;

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @(IOF),!!

 +3        WRITE "**********  PATIENTS SEEN AT LEAST N NUMBER OF TIMES  **********",!!

 +4        WRITE "This report will produce a list of patients who have been seen at least",!," N number of times in a date range specified by the user.",!

 +5        DO DBHUSRP^AMHUTIL

 +6        DO DBHUSR^AMHUTIL

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range during which the patient should be seen.",!

 +2        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter beginning Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AMHBD_":DT:EP"

           SET DIR("A")="Enter ending Date"

           SET Y=AMHBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AMHED=Y

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +5       ;

NUM       ;

 +1        SET DIR(0)="N^2:100:0"

           SET DIR("A")="Enter the minimum number of times the patient should have been seen"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO GETDATES

 +3        IF Y=""

               GOTO GETDATES

 +4        SET AMHNUM=+Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO NUM

ZIS       ;

 +1        SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to "

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT 

 +4        SET XBRC="PROC^AMHRP9"

           SET XBRP="^AMHRP9P"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHRP9"

 +5        DO ^XBDBQUE

XIT        KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHNUM,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHFOUN,AMHPOV,AMHRA,AMHRX,AMHRY

 +1        KILL AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP

 +2        QUIT 

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""^AMHRP9P"")"

 +2        SET XBNS="AMH"

           SET XBRC="PROC^AMHRP9"

           SET XBRX="XIT^AMHRP9"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

 +4       ;

PROC      ;EP - entry point for processing

 +1        SET AMHJOB=$JOB

           SET AMHBTH=$HOROLOG

           SET AMHTOT=0

           SET DFN=0

           SET AMHBT=$HOROLOG

 +2        DO XTMP^AMHUTIL("AMHRP9","BH - PTS WITH N VISITS")

 +3        FOR 

               SET DFN=$ORDER(^AMHREC("AE",DFN))

               IF DFN'=+DFN

                   QUIT 

               IF $$ALLOWP^AMHUTIL(DUZ,DFN)

                   DO PROC1

 +4        SET AMHET=$HOROLOG

 +5        KILL DFN

 +6        QUIT 

PROC1     ;

 +1        IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))

               QUIT 

VSTS      ; process visits

 +1        SET AMHR=0

           SET AMHBDO=9999999-AMHBD

           SET AMHEDO=9999999-AMHED

           SET AMHSD=AMHED-1

           SET AMHSD=AMHSD_".9999"

           SET AMHRCNT=0

 +2        FOR 

               SET AMHSD=$ORDER(^AMHREC("AE",DFN,AMHSD))

               IF $PIECE(AMHSD,".")>AMHBDO!(AMHSD="")

                   QUIT 

               Begin DoDot:1

 +3                SET AMHR=0

                   FOR 

                       SET AMHR=$ORDER(^AMHREC("AE",DFN,AMHSD,AMHR))

                       IF AMHR'=+AMHR

                           QUIT 

                       Begin DoDot:2

 +4                        IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)

                               QUIT 

 +5       ;COUNT # VISITS

                           SET AMHRCNT=AMHRCNT+1

                       End DoDot:2

 +6                QUIT 

               End DoDot:1

 +7        IF AMHRCNT'<AMHNUM

               SET ^XTMP("AMHRP9",AMHJOB,AMHBTH,$PIECE(^DPT(DFN,0),U),DFN)=""

 +8        QUIT 

 +9       ;