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
