AMHPACT ; IHS/CMI/LAB - All visit report driver ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
D INFORM
ZIS ;CALL TO XBDBQUE
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="PRINT^AMHPACT",XBRC="",XBRX="XIT^AMHPACT",XBNS="AMH"
D ^XBDBQUE
D XIT
Q
XIT ;EP
D EN^XBVK("AMH")
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^AMHPACT"")"
S XBNS="AMH",XBRC="",XBRX="XIT^AMHPACT",XBIOP=0 D ^XBDBQUE
Q
INFORM ;
W:$D(IOF) @IOF
W !,"****** PRINT/LIST ACTIVITY CODE TABLE ******",!
W !,"This report will print either to a printer or the screen, a list of all"
W !,"activity codes. It will list the code, short description, the category,"
W !,"and whether the code passes to PCC.",!
Q
;
PRINT ;EP
S AMHPG=0 D HEAD
K AMHQUIT
S AMHX="" F S AMHX=$O(^AMHTACT("AC",AMHX)) Q:AMHX=""!($D(AMHQUIT)) D
.S AMHY=0 F S AMHY=$O(^AMHTACT("AC",AMHX,AMHY)) Q:AMHY'=+AMHY!($D(AMHQUIT)) D
..I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
..W !,$P(^AMHTACT(AMHY,0),U,1),?5,$E($P(^AMHTACT(AMHY,0),U,2),1,50),?56,$E($$VAL^XBDIQ1(9002012,AMHY,.03),1,12),?70,$$VAL^XBDIQ1(9002012,AMHY,.04),?76,$$VAL^XBDIQ1(9002012,AMHY,.08),!
Q
HEAD I 'AMHPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !,$P(^VA(200,DUZ,0),U,2),?40,$$FMTE^XLFDT(DT),?68,"Page ",AMHPG,!
W !,$$CTR("********** BEHAVIORAL HEALTH ACTIVITY CODES **********",80),!
W !,"CODE",?5,"DESCRIPTION",?57,"CATEGORY",?70,"PCC",?76,"MNE"
W !,$TR($J(" ",80)," ","-")
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:IO'=IO(0)
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W !
S DIR("A")="End of Report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
AMHPACT ; IHS/CMI/LAB - All visit report driver ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 DO INFORM
ZIS ;CALL TO XBDBQUE
+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 XBRP="PRINT^AMHPACT"
SET XBRC=""
SET XBRX="XIT^AMHPACT"
SET XBNS="AMH"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
XIT ;EP
+1 DO EN^XBVK("AMH")
+2 QUIT
+3 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^AMHPACT"")"
+2 SET XBNS="AMH"
SET XBRC=""
SET XBRX="XIT^AMHPACT"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"****** PRINT/LIST ACTIVITY CODE TABLE ******",!
+3 WRITE !,"This report will print either to a printer or the screen, a list of all"
+4 WRITE !,"activity codes. It will list the code, short description, the category,"
+5 WRITE !,"and whether the code passes to PCC.",!
+6 QUIT
+7 ;
PRINT ;EP
+1 SET AMHPG=0
DO HEAD
+2 KILL AMHQUIT
+3 SET AMHX=""
FOR
SET AMHX=$ORDER(^AMHTACT("AC",AMHX))
IF AMHX=""!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+4 SET AMHY=0
FOR
SET AMHY=$ORDER(^AMHTACT("AC",AMHX,AMHY))
IF AMHY'=+AMHY!($DATA(AMHQUIT))
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+6 WRITE !,$PIECE(^AMHTACT(AMHY,0),U,1),?5,$EXTRACT($PIECE(^AMHTACT(AMHY,0),U,2),1,50),?56,$EXTRACT($$VAL^XBDIQ1(9002012,AMHY,.03),1,12),?70,$$VAL^XBDIQ1(9002012,AMHY,.04),?76,$$VAL^XBDIQ1(9002012,AMHY,.08),!
End DoDot:2
End DoDot:1
+7 QUIT
HEAD IF 'AMHPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?40,$$FMTE^XLFDT(DT),?68,"Page ",AMHPG,!
+3 WRITE !,$$CTR("********** BEHAVIORAL HEALTH ACTIVITY CODES **********",80),!
+4 WRITE !,"CODE",?5,"DESCRIPTION",?57,"CATEGORY",?70,"PCC",?76,"MNE"
+5 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+6 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF IO'=IO(0)
QUIT
+3 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+4 NEW DIR
+5 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+6 WRITE !
+7 SET DIR("A")="End of Report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
