AMHRL ; IHS/CMI/LAB - BH GENERAL RETRIEVAL DRIVER ;
;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10
START ;
I '$D(IOF) D HOME^%ZIS
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
I '$G(DUZ) W $C(7),$C(7),!!,"USER NOT SET IN DUZ - NOTIFY SITE MANAGER!!",!! Q
K AMHQUIT
I AMHPTVS="P" S AMHPTTX="Patient",AMHPTTS="Patients"
I AMHPTVS="S" S AMHPTTX="Suicide Form",AMHPTTS="Suicide Forms"
I AMHPTVS="V" S AMHPTTX="Visit",AMHPTTS="Visits"
TYPE ;--- get type of report (patient, date range or search template)
D INFORM^AMHRL01
I AMHPTVS="S" S AMHTYPE="SU" D SU,XIT Q
K DIR,X,Y S DIR(0)="S^S:Search Template"_$S(AMHPTVS="V":";D:Date Range",1:";P:Patient File"),DIR("A")="Select and Print "_$S(AMHPTVS="P":"Patient ",1:"Encounter ")_"List from" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S AMHTYPE=Y
D @AMHTYPE
D XIT
Q
P ;patient lister
D ADD I $D(AMHQUIT) D DEL K AMHQUIT G TYPE
I '$D(AMHCAND) D P1 Q
I $D(AMHCAND),$P(^AMHTRPT(AMHRPT,0),U,11) D I $D(DIRUT)!'($D(AMHBDD))!('$D(AMHEDD)) Q
.S AMHRDTR=""
.W !!,"You have selected at least one item that requires a date range selection."
.D GETDATES
D TITLE I $D(AMHQUIT) K AMHQUIT G TYPE
D ZIS
Q
P1 ;if patient, no prev defined report used
P11 K ^AMHTRPT(AMHRPT,11),AMHRDTR D SCREEN I $D(AMHQUIT) K AMHQUIT D DEL Q:AMHPTVS="S" G TYPE
I $D(AMHRDTR) D
.W !!,"You have selected at least one item that requires a date range selection."
.D GETDATES
.I '$D(AMHBDD)!('$D(AMHEDD))!($D(DIRUT)) G P11
P12 K ^AMHTRPT(AMHRPT,12) S AMHTCW=0 D COUNT I $D(AMHQUIT) K AMHQUIT G P11
P13 D TITLE I $D(AMHQUIT) K AMHQUIT G P12
D SAVE
D ZIS
Q
S ;--- search template
D S0
Q:$D(AMHQUIT)
S1 ;EP
D ADD I $D(AMHQUIT) G S
S12 K ^AMHTRPT(AMHRPT,12) S AMHTCW=0 D COUNT I $D(AMHQUIT) K AMHQUIT G S
S13 D TITLE I $D(AMHQUIT) K AMHQUIT G S12
D ZIS
Q
S0 ;
S:AMHPTVS="V" DIC("S")="I $P(^(0),U,4)=9002011" S:AMHPTVS="P" DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S AMHQUIT="" Q
S AMHSEAT=+Y
;
Q
D ;
GETDATES ;
BD ;get beginning date
W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Encounter Date for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D DEL G TYPE
S AMHBD=Y
ED ;get ending date
W ! K DIR,X,Y S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Encounter 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 AMHD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
Q:$D(AMHRDTR)
D ADD I $D(AMHQUIT) D DEL K AMHQUIT G D
I '$D(AMHCAND) D D1 Q
D TITLE I $D(AMHQUIT) K AMHQUIT G TYPE
D ZIS
Q
SU ;
SBD ;get beginning date
W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Date for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D XIT Q
S AMHBD=Y
SED ;get ending date
W ! K DIR,X,Y S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Date for search" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G SBD
S AMHED=Y
S X1=AMHBD,X2=-1 D C^%DTC S AMHD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
D ADD I $D(AMHQUIT) D DEL K AMHQUIT D XIT Q
I '$D(AMHCAND) D P1 Q
D TITLE I $D(AMHQUIT) K AMHQUIT G TYPE ;**
D ZIS ;**
Q ;**
D1 ;if visit, no prev defined report used
D11 K ^AMHTRPT(AMHRPT,11),AMHRDTR D SCREEN I $D(AMHQUIT) K AMHQUIT D DEL D XIT Q
D12 K ^AMHTRPT(AMHRPT,12) S AMHTCW=0 D COUNT I $D(AMHQUIT) K AMHQUIT G D11
D13 D TITLE I $D(AMHQUIT) K AMHQUIT G D12
D SAVE
D ZIS
Q
SCREEN ;
;D SCREEN^AMHRL3
S AMHCNTL="S" D ^AMHRL4
Q
COUNT ;count only or detailed report
D COUNT^AMHRL3
Q
TITLE ;
Q:AMHCTYP="F"
Q:AMHCTYP="T"
K DIR,X,Y S DIR(0)="Y",DIR("A")="Would you like a custom title for this report",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S AMHQUIT=1 Q
Q:Y=0
S AMHLENG=$S(AMHTCW:AMHTCW-8,1:60)
I Y=1 K DIR,X,Y S DIR(0)="F^3:"_AMHLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_AMHLENG_" characters" D ^DIR K DIR
G:$D(DIRUT) TITLE
S AMHTITL=Y
Q
SAVE ;
Q:$D(AMHCAND)
Q:AMHCTYP'="D" ;--- must be a detailed report to be saved
S AMHSAVE=""
K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(AMHEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
K DIR,X,Y S DIR(0)="9001003.8,.03",DIR("A")="Enter NAME for this REPORT DEFINITION" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) SAVE
S AMHNAME=Y
S DIE="^AMHTRPT(",DA=AMHRPT,DR=".02////1;.03///"_AMHNAME_";.06///"_AMHPTVS_";.05///"_AMHCTYP_";.11///"_$G(AMHRDTR) S:$D(AMHEP1) DR=DR_";.09///"_AMHPACK D CALLDIE^AMHLEIN
Q
ZIS ;call to XBDBQUE
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 Q
I 'AMHTCW S AMHTCW=IOM
S AMHDONE=""
D SHOW^AMHRLS,SHOWP^AMHRLS I AMHCTYP'="T",AMHCTYP'="S" D SHOWR^AMHRLS
D XIT1
I AMHCTYP="D"!(AMHCTYP="S") D
.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) S AMHQUIT="" Q
.S AMHOPT=Y
G:$G(AMHQUIT) SAVE
I $G(AMHOPT)="B" D BROWSE,XIT Q
S XBRP="^AMHRLP",XBRC="^AMHRL1",XBRX="XIT^AMHRL",XBNS="AMH"
D ^XBDBQUE
D XIT
Q
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
I $G(AMHRPT),$D(^AMHTRPT(AMHRPT,0)),'$P(^AMHTRPT(AMHRPT,0),U,2) S DIK="^AMHTRPT(",DA=AMHRPT D ^DIK K DIK,DA,DIC
Q
ADD ;
D ADD^AMHRL01
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRLP"")"
S XBRC="^AMHRL1",XBRX="XIT^AMHRL",XBIOP=0 D ^XBDBQUE
Q
XIT ;
D XIT^AMHRL1
K AMHOPT
XIT1 ;
D XIT1^AMHRL1
Q
AMHRL ; IHS/CMI/LAB - BH GENERAL RETRIEVAL DRIVER ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
QUIT
+3 IF '$GET(DUZ)
WRITE $CHAR(7),$CHAR(7),!!,"USER NOT SET IN DUZ - NOTIFY SITE MANAGER!!",!!
QUIT
+4 KILL AMHQUIT
+5 IF AMHPTVS="P"
SET AMHPTTX="Patient"
SET AMHPTTS="Patients"
+6 IF AMHPTVS="S"
SET AMHPTTX="Suicide Form"
SET AMHPTTS="Suicide Forms"
+7 IF AMHPTVS="V"
SET AMHPTTX="Visit"
SET AMHPTTS="Visits"
TYPE ;--- get type of report (patient, date range or search template)
+1 DO INFORM^AMHRL01
+2 IF AMHPTVS="S"
SET AMHTYPE="SU"
DO SU
DO XIT
QUIT
+3 KILL DIR,X,Y
SET DIR(0)="S^S:Search Template"_$SELECT(AMHPTVS="V":";D:Date Range",1:";P:Patient File")
SET DIR("A")="Select and Print "_$SELECT(AMHPTVS="P":"Patient ",1:"Encounter ")_"List from"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO XIT
+5 SET AMHTYPE=Y
+6 DO @AMHTYPE
+7 DO XIT
+8 QUIT
P ;patient lister
+1 DO ADD
IF $DATA(AMHQUIT)
DO DEL
KILL AMHQUIT
GOTO TYPE
+2 IF '$DATA(AMHCAND)
DO P1
QUIT
+3 IF $DATA(AMHCAND)
IF $PIECE(^AMHTRPT(AMHRPT,0),U,11)
Begin DoDot:1
+4 SET AMHRDTR=""
+5 WRITE !!,"You have selected at least one item that requires a date range selection."
+6 DO GETDATES
End DoDot:1
IF $DATA(DIRUT)!'($DATA(AMHBDD))!('$DATA(AMHEDD))
QUIT
+7 DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO TYPE
+8 DO ZIS
+9 QUIT
P1 ;if patient, no prev defined report used
P11 KILL ^AMHTRPT(AMHRPT,11),AMHRDTR
DO SCREEN
IF $DATA(AMHQUIT)
KILL AMHQUIT
DO DEL
IF AMHPTVS="S"
QUIT
GOTO TYPE
+1 IF $DATA(AMHRDTR)
Begin DoDot:1
+2 WRITE !!,"You have selected at least one item that requires a date range selection."
+3 DO GETDATES
+4 IF '$DATA(AMHBDD)!('$DATA(AMHEDD))!($DATA(DIRUT))
GOTO P11
End DoDot:1
P12 KILL ^AMHTRPT(AMHRPT,12)
SET AMHTCW=0
DO COUNT
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO P11
P13 DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO P12
+1 DO SAVE
+2 DO ZIS
+3 QUIT
S ;--- search template
+1 DO S0
+2 IF $DATA(AMHQUIT)
QUIT
S1 ;EP
+1 DO ADD
IF $DATA(AMHQUIT)
GOTO S
S12 KILL ^AMHTRPT(AMHRPT,12)
SET AMHTCW=0
DO COUNT
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO S
S13 DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO S12
+1 DO ZIS
+2 QUIT
S0 ;
+1 IF AMHPTVS="V"
SET DIC("S")="I $P(^(0),U,4)=9002011"
IF AMHPTVS="P"
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
SET DIC="^DIBT("
SET DIC("A")="Enter SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+2 IF Y=-1
SET AMHQUIT=""
QUIT
+3 SET AMHSEAT=+Y
+4 ;
+5 QUIT
D ;
GETDATES ;
BD ;get beginning date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning Encounter Date for search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
DO DEL
GOTO TYPE
+3 SET AMHBD=Y
ED ;get ending date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^"_AMHBD_":DT:EP"
SET DIR("A")="Enter Ending Encounter 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 AMHD=X
SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+5 IF $DATA(AMHRDTR)
QUIT
+6 DO ADD
IF $DATA(AMHQUIT)
DO DEL
KILL AMHQUIT
GOTO D
+7 IF '$DATA(AMHCAND)
DO D1
QUIT
+8 DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO TYPE
+9 DO ZIS
+10 QUIT
SU ;
SBD ;get beginning date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning Date for search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
DO XIT
QUIT
+3 SET AMHBD=Y
SED ;get ending date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^"_AMHBD_":DT:EP"
SET DIR("A")="Enter Ending Date for search"
SET Y=AMHBD
DO DD^%DT
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO SBD
+3 SET AMHED=Y
+4 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHD=X
SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+5 DO ADD
IF $DATA(AMHQUIT)
DO DEL
KILL AMHQUIT
DO XIT
QUIT
+6 IF '$DATA(AMHCAND)
DO P1
QUIT
+7 ;**
DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO TYPE
+8 ;**
DO ZIS
+9 ;**
QUIT
D1 ;if visit, no prev defined report used
D11 KILL ^AMHTRPT(AMHRPT,11),AMHRDTR
DO SCREEN
IF $DATA(AMHQUIT)
KILL AMHQUIT
DO DEL
DO XIT
QUIT
D12 KILL ^AMHTRPT(AMHRPT,12)
SET AMHTCW=0
DO COUNT
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO D11
D13 DO TITLE
IF $DATA(AMHQUIT)
KILL AMHQUIT
GOTO D12
+1 DO SAVE
+2 DO ZIS
+3 QUIT
SCREEN ;
+1 ;D SCREEN^AMHRL3
+2 SET AMHCNTL="S"
DO ^AMHRL4
+3 QUIT
COUNT ;count only or detailed report
+1 DO COUNT^AMHRL3
+2 QUIT
TITLE ;
+1 IF AMHCTYP="F"
QUIT
+2 IF AMHCTYP="T"
QUIT
+3 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Would you like a custom title for this report"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
SET AMHQUIT=1
QUIT
+5 IF Y=0
QUIT
+6 SET AMHLENG=$SELECT(AMHTCW:AMHTCW-8,1:60)
+7 IF Y=1
KILL DIR,X,Y
SET DIR(0)="F^3:"_AMHLENG
SET DIR("A")="Enter custom title"
SET DIR("?")=" Enter from 3 to "_AMHLENG_" characters"
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO TITLE
+9 SET AMHTITL=Y
+10 QUIT
SAVE ;
+1 IF $DATA(AMHCAND)
QUIT
+2 ;--- must be a detailed report to be saved
IF AMHCTYP'="D"
QUIT
+3 SET AMHSAVE=""
+4 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Do you wish to SAVE this "_$SELECT('$DATA(AMHEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
QUIT
+6 IF 'Y
QUIT
+7 KILL DIR,X,Y
SET DIR(0)="9001003.8,.03"
SET DIR("A")="Enter NAME for this REPORT DEFINITION"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+8 IF $DATA(DIRUT)
GOTO SAVE
+9 SET AMHNAME=Y
+10 SET DIE="^AMHTRPT("
SET DA=AMHRPT
SET DR=".02////1;.03///"_AMHNAME_";.06///"_AMHPTVS_";.05///"_AMHCTYP_";.11///"_$GET(AMHRDTR)
IF $DATA(AMHEP1)
SET DR=DR_";.09///"_AMHPACK
DO CALLDIE^AMHLEIN
+11 QUIT
ZIS ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
QUIT
+3 IF 'AMHTCW
SET AMHTCW=IOM
+4 SET AMHDONE=""
+5 DO SHOW^AMHRLS
DO SHOWP^AMHRLS
IF AMHCTYP'="T"
IF AMHCTYP'="S"
DO SHOWR^AMHRLS
+6 DO XIT1
+7 IF AMHCTYP="D"!(AMHCTYP="S")
Begin 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)
SET AMHQUIT=""
QUIT
+10 SET AMHOPT=Y
End DoDot:1
+11 IF $GET(AMHQUIT)
GOTO SAVE
+12 IF $GET(AMHOPT)="B"
DO BROWSE
DO XIT
QUIT
+13 SET XBRP="^AMHRLP"
SET XBRC="^AMHRL1"
SET XBRX="XIT^AMHRL"
SET XBNS="AMH"
+14 DO ^XBDBQUE
+15 DO XIT
+16 QUIT
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
+1 IF $GET(AMHRPT)
IF $DATA(^AMHTRPT(AMHRPT,0))
IF '$PIECE(^AMHTRPT(AMHRPT,0),U,2)
SET DIK="^AMHTRPT("
SET DA=AMHRPT
DO ^DIK
KILL DIK,DA,DIC
+2 QUIT
ADD ;
+1 DO ADD^AMHRL01
+2 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRLP"")"
+2 SET XBRC="^AMHRL1"
SET XBRX="XIT^AMHRL"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
XIT ;
+1 DO XIT^AMHRL1
+2 KILL AMHOPT
XIT1 ;
+1 DO XIT1^AMHRL1
+2 QUIT
