AMHRPT.m

AMHRPT ; IHS/CMI/LAB - APC visit counts by selected vars ;

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

 ;

START ; 

 D HOME^%ZIS

 K AMHQUIT

 I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q

 I $D(AMHRPTC) D

 .S AMHRPTI=$P(^AMHRCNT(AMHRPTC,0),U,2),AMHRPTPA=$P(^(0),U,3),AMHRPTP=$P(^(0),U,4),AMHRPTST=$P(^AMHRCNT(AMHRPTC,0),U,7) S:AMHRPTST]"" AMHRPTST=$TR(AMHRPTST,"~","^")

 .S AMHRPRCR=$P(^AMHRCNT(AMHRPTC,0),U,5) S:AMHRPRCR]"" AMHRPRCR=$TR(AMHRPRCR,"~","^")

 I AMHRPTI]"" S AMHRPTI=$TR(AMHRPTI,"~","^") D @(AMHRPTI) ;inform user what report will do

 G:$D(AMHQUIT) XIT

 S AMHTCW=0,AMHPCNT=0

 S AMHPTVS="V",AMHXREF=$S(AMHPTVS="V":"C",1:"PO")

GETDATES ;

BD ;get beginning date

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date for Search" 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 Visit Date for Search" 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

 D ADD ;add report to temporary fileman report file

 I $D(AMHQUIT) W !!,"Unable to create report temporary file entry!!," G XIT

 ;

 D SHOW

SCREEN ;

 K ^AMHTRPT(AMHRPT,11) S AMHCNTL="S",AMHTYPE="D",AMHPTTX="Visit",AMHPTTS="Visits" D ^AMHRL4 K AMHCNTL I $D(AMHQUIT) D DEL^AMHRL G GETDATES

PRINT ;print portion of report

 I $G(AMHRPTP)]"" S AMHRPTPA=$TR(AMHRPTPA,"~","^"),AMHRPTP=$TR(AMHRPTP,"~","^") D:$G(AMHRPTPA)]"" @(AMHRPTPA) G:$D(AMHQUIT) START G SORT

 D PMENU^AMHRPT0

 S DIR(0)="LO^1:"_AMHHIGH,DIR("A")="Select print item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" G SORT

 I $D(DIRUT) D DEL G START

 W !!?15,"Total Report width (including column margins - 2 spaces):  ",AMHTCW

 D PSELECT^AMHRPT1

 D SHOWP

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional PRINT items",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) START

 I Y=0 G SORT

 G PRINT

SORT ;

 I '$D(^AMHTRPT(AMHRPT,12)),'$D(AMHRPTP) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) D DEL G START

 I '$P(^AMHRCNT(AMHRPTC,0),U,8) G DEMO

 S AMHSORT="",AMHCTYP="D"

 D SHOWR

 S AMHCNTL="R" D ^AMHRL4 K AMHCNTL

PAGE ;

 Q:'$D(AMHSORV)

 K AMHSPAG

 S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_AMHSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G SORT

 S AMHSPAG=Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G PAGE

ZIS ;call to XBDBQUE

 D TERM^VALM0

 D KILLVARS

 I "36"[AMHRPTC,$D(^AMHBHUSR(DUZ)),$O(^AMHBHUSR(DUZ,11,0)) D

 .W !!,$G(IORVON),"Please note:",$G(IORVOFF),"  Only visits to the following locations will"

 .W !?15,"be tallied in this report:"

 .S X=0 F  S X=$O(^AMHBHUSR(DUZ,11,X)) Q:X'=+X  W !?15,$P(^DIC(4,X,0),U)

 .W !!

 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 XBRP=$S($G(AMHRPTP)]"":AMHRPTP,1:"^AMHRPTP"),XBRC=$S($G(AMHRPRCR)]"":AMHRPRCR,1:"^AMHRPT4"),XBRX="XIT^AMHRPT",XBNS="AMH"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

 S P=$S($G(AMHRPTP)]"":AMHRPTP,1:"^AMHRPTP"),XBRP="VIEWR^XBLM("""_P_""")"

 S XBNS="AMH",XBRC=$S($G(AMHRPRCR)]"":AMHRPRCR,1:"^AMHRPT4"),XBRX="XIT^AMHRPT",XBIOP=0 D ^XBDBQUE

 Q

SHOW ;

 W:$D(IOF) @IOF

 I $D(AMHDONE) S AMHLHDR="REPORT SUMMARY" W ?((80-$L(AMHLHDR))/2),AMHLHDR,!

 W !?6,"Record selection criteria:"

 W !,"Encounter Date range:  ",AMHBDD," to ",AMHEDD,"."

 Q:'$D(^AMHTRPT(AMHRPT,11))

 S AMHI=0 F  S AMHI=$O(^AMHTRPT(AMHRPT,11,AMHI)) Q:AMHI'=+AMHI  D

 .I $Y>(IOSL-5) D PAUSE^AMHRPTU W @IOF

 .W !?12,$P(^AMHSORT(AMHI,0),U),":  "

 .S Y=0,C=0 F  S Y=$O(^AMHTRPT(AMHRPT,11,AMHI,11,"B",Y)) S C=C+1 W:C'=1&(Y'="") " ; " Q:Y=""  S X=Y X:$D(^AMHSORT(AMHI,2)) ^(2) D

 ..W X

 K C

 Q

SHOWP ;

 I '$D(AMHDONE) W:$D(IOF) @IOF

 W !!?6,"PRINT Field(s) Selected:"

 ;Q:'$D(^AMHTRPT(AMHRPT,12))

 S (AMHI,AMHTCW)=0 F  S AMHI=$O(^AMHTRPT(AMHRPT,12,AMHI)) Q:AMHI'=+AMHI  S AMHCRIT=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U) D

 .W !?12,$P(^AMHSORT(AMHCRIT,0),U)," - column width ",$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2) S AMHTCW=AMHTCW+$P(^(0),U,2)+2

 .I $Y>(IOSL-5) D PAUSE^AMHRPTU W:$D(IOF) @IOF

 W !!?12,"Total Report width (including column margins - 2 spaces):   ",AMHTCW

 Q

SHOWR ;

 I '$D(AMHDONE) W:$D(IOF) @IOF

 W !!?6,"Record SORTING Criteria"

 Q:'$G(AMHTRPT)

 W !!?12,"Records will be sorted by:  ",$P(^AMHSORT(AMHTRPT,0),U),!

 Q

DEL ;EP - delete entry in temp file

 I $G(AMHRPT) S DIK="^AMHTRPT(",DA=AMHRPT D ^DIK K DIK,DA,DIC

 Q

KILLVARS ;

 K AMHDISP,AMHSEL

 Q

XIT ;

 D KILL^AMHRPTX

 Q

ADD ;EP

 S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^AMHTRPT(",DLAYGO=9002013.8,DIADD=1 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S AMHQUIT=1 Q

 S AMHRPT=+Y

 K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 ;DELETE ALL 11 MULTIPLE HERE

 K ^AMHTRPT(AMHRPT,11)

 Q

AMHRPT    ; IHS/CMI/LAB - APC visit counts by selected vars ;

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

 +2       ;

START     ; 

 +1        DO HOME^%ZIS

 +2        KILL AMHQUIT

 +3        IF '$GET(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!

               QUIT 

 +4        IF $DATA(AMHRPTC)

               Begin DoDot:1

 +5                SET AMHRPTI=$PIECE(^AMHRCNT(AMHRPTC,0),U,2)

                   SET AMHRPTPA=$PIECE(^(0),U,3)

                   SET AMHRPTP=$PIECE(^(0),U,4)

                   SET AMHRPTST=$PIECE(^AMHRCNT(AMHRPTC,0),U,7)

                   IF AMHRPTST]""

                       SET AMHRPTST=$TRANSLATE(AMHRPTST,"~","^")

 +6                SET AMHRPRCR=$PIECE(^AMHRCNT(AMHRPTC,0),U,5)

                   IF AMHRPRCR]""

                       SET AMHRPRCR=$TRANSLATE(AMHRPRCR,"~","^")

               End DoDot:1

 +7       ;inform user what report will do

           IF AMHRPTI]""

               SET AMHRPTI=$TRANSLATE(AMHRPTI,"~","^")

               DO @(AMHRPTI)

 +8        IF $DATA(AMHQUIT)

               GOTO XIT

 +9        SET AMHTCW=0

           SET AMHPCNT=0

 +10       SET AMHPTVS="V"

           SET AMHXREF=$SELECT(AMHPTVS="V":"C",1:"PO")

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !

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

           SET DIR("A")="Enter beginning Visit Date for Search"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

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

           SET DIR("A")="Enter ending Visit Date for Search"

           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       ;add report to temporary fileman report file

           DO ADD

 +6        IF $DATA(AMHQUIT)

               WRITE !!,"Unable to create report temporary file entry!!,"

               GOTO XIT

 +7       ;

 +8        DO SHOW

SCREEN    ;

 +1        KILL ^AMHTRPT(AMHRPT,11)

           SET AMHCNTL="S"

           SET AMHTYPE="D"

           SET AMHPTTX="Visit"

           SET AMHPTTS="Visits"

           DO ^AMHRL4

           KILL AMHCNTL

           IF $DATA(AMHQUIT)

               DO DEL^AMHRL

               GOTO GETDATES

PRINT     ;print portion of report

 +1        IF $GET(AMHRPTP)]""

               SET AMHRPTPA=$TRANSLATE(AMHRPTPA,"~","^")

               SET AMHRPTP=$TRANSLATE(AMHRPTP,"~","^")

               IF $GET(AMHRPTPA)]""

                   DO @(AMHRPTPA)

               IF $DATA(AMHQUIT)

                   GOTO START

               GOTO SORT

 +2        DO PMENU^AMHRPT0

 +3        SET DIR(0)="LO^1:"_AMHHIGH

           SET DIR("A")="Select print item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               GOTO SORT

 +5        IF $DATA(DIRUT)

               DO DEL

               GOTO START

 +6        WRITE !!?15,"Total Report width (including column margins - 2 spaces):  ",AMHTCW

 +7        DO PSELECT^AMHRPT1

 +8        DO SHOWP

 +9        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional PRINT items"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +10       IF $DATA(DUOUT)

               SET DIRUT=1

 +11       IF $DATA(DIRUT)

               GOTO START

 +12       IF Y=0

               GOTO SORT

 +13       GOTO PRINT

SORT      ;

 +1        IF '$DATA(^AMHTRPT(AMHRPT,12))

               IF '$DATA(AMHRPTP)

                   WRITE !!,"NO PRINT FIELDS SELECTED!!",$CHAR(7),$CHAR(7)

                   DO DEL

                   GOTO START

 +2        IF '$PIECE(^AMHRCNT(AMHRPTC,0),U,8)

               GOTO DEMO

 +3        SET AMHSORT=""

           SET AMHCTYP="D"

 +4        DO SHOWR

 +5        SET AMHCNTL="R"

           DO ^AMHRL4

           KILL AMHCNTL

PAGE      ;

 +1        IF '$DATA(AMHSORV)

               QUIT 

 +2        KILL AMHSPAG

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want a separate page for each "_AMHSORV

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO SORT

 +5        SET AMHSPAG=Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO PAGE

ZIS       ;call to XBDBQUE

 +1        DO TERM^VALM0

 +2        DO KILLVARS

 +3        IF "36"[AMHRPTC

               IF $DATA(^AMHBHUSR(DUZ))

                   IF $ORDER(^AMHBHUSR(DUZ,11,0))

                       Begin DoDot:1

 +4                        WRITE !!,$GET(IORVON),"Please note:",$GET(IORVOFF),"  Only visits to the following locations will"

 +5                        WRITE !?15,"be tallied in this report:"

 +6                        SET X=0

                           FOR 

                               SET X=$ORDER(^AMHBHUSR(DUZ,11,X))

                               IF X'=+X

                                   QUIT 

                               WRITE !?15,$PIECE(^DIC(4,X,0),U)

 +7                        WRITE !!

                       End DoDot:1

 +8        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

 +9        IF $DATA(DIRUT)

               GOTO XIT

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

               DO BROWSE

               DO XIT

               QUIT 

 +11       SET XBRP=$SELECT($GET(AMHRPTP)]"":AMHRPTP,1:"^AMHRPTP")

           SET XBRC=$SELECT($GET(AMHRPRCR)]"":AMHRPRCR,1:"^AMHRPT4")

           SET XBRX="XIT^AMHRPT"

           SET XBNS="AMH"

 +12       DO ^XBDBQUE

 +13       DO XIT

 +14       QUIT 

BROWSE    ;

 +1        SET P=$SELECT($GET(AMHRPTP)]"":AMHRPTP,1:"^AMHRPTP")

           SET XBRP="VIEWR^XBLM("""_P_""")"

 +2        SET XBNS="AMH"

           SET XBRC=$SELECT($GET(AMHRPRCR)]"":AMHRPRCR,1:"^AMHRPT4")

           SET XBRX="XIT^AMHRPT"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

SHOW      ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        IF $DATA(AMHDONE)

               SET AMHLHDR="REPORT SUMMARY"

               WRITE ?((80-$LENGTH(AMHLHDR))/2),AMHLHDR,!

 +3        WRITE !?6,"Record selection criteria:"

 +4        WRITE !,"Encounter Date range:  ",AMHBDD," to ",AMHEDD,"."

 +5        IF '$DATA(^AMHTRPT(AMHRPT,11))

               QUIT 

 +6        SET AMHI=0

           FOR 

               SET AMHI=$ORDER(^AMHTRPT(AMHRPT,11,AMHI))

               IF AMHI'=+AMHI

                   QUIT 

               Begin DoDot:1

 +7                IF $Y>(IOSL-5)

                       DO PAUSE^AMHRPTU

                       WRITE @IOF

 +8                WRITE !?12,$PIECE(^AMHSORT(AMHI,0),U),":  "

 +9                SET Y=0

                   SET C=0

                   FOR 

                       SET Y=$ORDER(^AMHTRPT(AMHRPT,11,AMHI,11,"B",Y))

                       SET C=C+1

                       IF C'=1&(Y'="")

                           WRITE " ; "

                       IF Y=""

                           QUIT 

                       SET X=Y

                       IF $DATA(^AMHSORT(AMHI,2))

                           XECUTE ^(2)

                       Begin DoDot:2

 +10                       WRITE X

                       End DoDot:2

               End DoDot:1

 +11       KILL C

 +12       QUIT 

SHOWP     ;

 +1        IF '$DATA(AMHDONE)

               IF $DATA(IOF)

                   WRITE @IOF

 +2        WRITE !!?6,"PRINT Field(s) Selected:"

 +3       ;Q:'$D(^AMHTRPT(AMHRPT,12))

 +4        SET (AMHI,AMHTCW)=0

           FOR 

               SET AMHI=$ORDER(^AMHTRPT(AMHRPT,12,AMHI))

               IF AMHI'=+AMHI

                   QUIT 

               SET AMHCRIT=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U)

               Begin DoDot:1

 +5                WRITE !?12,$PIECE(^AMHSORT(AMHCRIT,0),U)," - column width ",$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)

                   SET AMHTCW=AMHTCW+$PIECE(^(0),U,2)+2

 +6                IF $Y>(IOSL-5)

                       DO PAUSE^AMHRPTU

                       IF $DATA(IOF)

                           WRITE @IOF

               End DoDot:1

 +7        WRITE !!?12,"Total Report width (including column margins - 2 spaces):   ",AMHTCW

 +8        QUIT 

SHOWR     ;

 +1        IF '$DATA(AMHDONE)

               IF $DATA(IOF)

                   WRITE @IOF

 +2        WRITE !!?6,"Record SORTING Criteria"

 +3        IF '$GET(AMHTRPT)

               QUIT 

 +4        WRITE !!?12,"Records will be sorted by:  ",$PIECE(^AMHSORT(AMHTRPT,0),U),!

 +5        QUIT 

DEL       ;EP - delete entry in temp file

 +1        IF $GET(AMHRPT)

               SET DIK="^AMHTRPT("

               SET DA=AMHRPT

               DO ^DIK

               KILL DIK,DA,DIC

 +2        QUIT 

KILLVARS  ;

 +1        KILL AMHDISP,AMHSEL

 +2        QUIT 

XIT       ;

 +1        DO KILL^AMHRPTX

 +2        QUIT 

ADD       ;EP

 +1        SET %H=$HOROLOG

           DO YX^%DTC

           SET X=$PIECE(^VA(200,DUZ,0),U)_"-"_Y

           SET DIC(0)="L"

           SET DIC="^AMHTRPT("

           SET DLAYGO=9002013.8

           SET DIADD=1

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO

           IF Y=-1

               WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"

               SET AMHQUIT=1

               QUIT 

 +2        SET AMHRPT=+Y

 +3        KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 +4       ;DELETE ALL 11 MULTIPLE HERE

 +5        KILL ^AMHTRPT(AMHRPT,11)

 +6        QUIT