ACDRL ;IHS/ADC/EDE/KML - CDMIS GENERAL RETRIEVAL DRIVER;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
START ;
K ACDQUIT
TYPE ;--- get type of report (patient, date range or search template)
D INFORM^ACDRL01
D @ACDPTVS
D XIT
Q
P ;patient lister
D ADD I $D(ACDQUIT) D DEL K ACDQUIT G XIT
I '$D(ACDCAND) D P1 Q
I $D(ACDCAND),$P(^ACDRPTD(ACDRPT,0),U,11) D I $D(DIRUT)!'($D(ACDBDD))!('$D(ACDEDD)) Q
.S ACDRDTR=""
.W !!,"You have selected at least one item that requires a date range selection."
.D GETDATES
D TITLE I $D(ACDQUIT) K ACDQUIT G TYPE
D ZIS
Q
P1 ;if patient, no prev defined report used
P11 K ^ACDRPTD(ACDRPT,11),ACDRDTR D SCREEN I $D(ACDQUIT) K ACDQUIT D DEL G TYPE
I $D(ACDRDTR) D
.W !!,"You have selected at least one item that requires a date range selection."
.D GETDATES
P12 K ^ACDRPTD(ACDRPT,12) S ACDTCW=0 D COUNT I $D(ACDQUIT) K ACDQUIT G P11
P13 D TITLE I $D(ACDQUIT) K ACDQUIT G P12
D SAVE
D ZIS
Q
V ;
GETDATES ;
BD ;get beginning date
W ! K DIR,X,Y 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) D DEL G XIT
S ACDBD=Y
ED ;get ending date
W ! K DIR,X,Y S DIR(0)="D^"_ACDBD_":DT:EP",DIR("A")="Enter Ending Visit Date for search" S Y=ACDBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S ACDED=Y
S X1=ACDBD,X2=-1 D C^%DTC S ACDD=X S Y=ACDBD D DD^%DT S ACDBDD=Y S Y=ACDED D DD^%DT S ACDEDD=Y
Q:$D(ACDRDTR)
D ADD I $D(ACDQUIT) D DEL K ACDQUIT G V
I '$D(ACDCAND) D V1 Q
D TITLE I $D(ACDQUIT) K ACDQUIT G TYPE
D ZIS
Q
V1 ;if visit, no prev defined report used
V11 K ^ACDRPTD(ACDRPT,11),ACDRDTR D SCREEN I $D(ACDQUIT) K ACDQUIT D DEL G V
V12 K ^ACDRPTD(ACDRPT,12) S ACDTCW=0 D COUNT I $D(ACDQUIT) K ACDQUIT G V11
V13 D TITLE I $D(ACDQUIT) K ACDQUIT G V12
D SAVE
D ZIS
Q
SCREEN ;
S ACDCNTL="S" D ^ACDRL4 K ACDCNTL
Q
COUNT ;count only or detailed report
D COUNT^ACDRL3
Q
TITLE ;
Q:ACDCTYP="F"
Q:ACDCTYP="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 ACDQUIT=1 Q
Q:Y=0
S ACDLENG=$S(ACDTCW:ACDTCW-8,1:60)
I Y=1 K DIR,X,Y S DIR(0)="F^3:"_ACDLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_ACDLENG_" characters" D ^DIR K DIR
G:$D(DIRUT) TITLE
S ACDTITL=Y
Q
SAVE ;
Q:$D(ACDCAND)
Q:ACDCTYP'="D" ;--- must be a detailed report to be saved
S ACDSAVE=""
K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(ACDEP1):"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 ACDNAME=Y
S DIE="^ACDRPTD(",DA=ACDRPT,DR=".02////1;.03///"_ACDNAME_";.06///"_ACDPTVS_";.05///"_ACDCTYP_";.11///"_$G(ACDRDTR) S:$D(ACDEP1) DR=DR_";.09///"_ACDPACK D CALLDIE^ACDRLU1
Q
ZIS ;call to XBDBQUE
I 'ACDTCW S ACDTCW=IOM
S ACDDONE=""
D SHOW^ACDRLS,SHOWP^ACDRLS,SHOWR^ACDRLS
D XIT1
S XBRP="^ACDRLP",XBRC="^ACDRL1",XBRX="XIT^ACDRL",XBNS="ACD"
D ^XBDBQUE
D XIT
Q
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
I $G(ACDRPT),$D(^ACDRPTD(ACDRPT,0)),'$P(^ACDRPTD(ACDRPT,0),U,2) S DIK="^ACDRPTD(",DA=ACDRPT D ^DIK K DIK,DA,DIC
Q
ADD ;
D ADD^ACDRL01
Q
XIT ;
D XIT^ACDRL1
XIT1 ;
D XIT1^ACDRL1
Q
ACDRL ;IHS/ADC/EDE/KML - CDMIS GENERAL RETRIEVAL DRIVER;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
START ;
+1 KILL ACDQUIT
TYPE ;--- get type of report (patient, date range or search template)
+1 DO INFORM^ACDRL01
+2 DO @ACDPTVS
+3 DO XIT
+4 QUIT
P ;patient lister
+1 DO ADD
IF $DATA(ACDQUIT)
DO DEL
KILL ACDQUIT
GOTO XIT
+2 IF '$DATA(ACDCAND)
DO P1
QUIT
+3 IF $DATA(ACDCAND)
IF $PIECE(^ACDRPTD(ACDRPT,0),U,11)
Begin DoDot:1
+4 SET ACDRDTR=""
+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(ACDBDD))!('$DATA(ACDEDD))
QUIT
+7 DO TITLE
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO TYPE
+8 DO ZIS
+9 QUIT
P1 ;if patient, no prev defined report used
P11 KILL ^ACDRPTD(ACDRPT,11),ACDRDTR
DO SCREEN
IF $DATA(ACDQUIT)
KILL ACDQUIT
DO DEL
GOTO TYPE
+1 IF $DATA(ACDRDTR)
Begin DoDot:1
+2 WRITE !!,"You have selected at least one item that requires a date range selection."
+3 DO GETDATES
End DoDot:1
P12 KILL ^ACDRPTD(ACDRPT,12)
SET ACDTCW=0
DO COUNT
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO P11
P13 DO TITLE
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO P12
+1 DO SAVE
+2 DO ZIS
+3 QUIT
V ;
GETDATES ;
BD ;get beginning date
+1 WRITE !
KILL DIR,X,Y
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)
DO DEL
GOTO XIT
+3 SET ACDBD=Y
ED ;get ending date
+1 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^"_ACDBD_":DT:EP"
SET DIR("A")="Enter Ending Visit Date for search"
SET Y=ACDBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET ACDED=Y
+4 SET X1=ACDBD
SET X2=-1
DO C^%DTC
SET ACDD=X
SET Y=ACDBD
DO DD^%DT
SET ACDBDD=Y
SET Y=ACDED
DO DD^%DT
SET ACDEDD=Y
+5 IF $DATA(ACDRDTR)
QUIT
+6 DO ADD
IF $DATA(ACDQUIT)
DO DEL
KILL ACDQUIT
GOTO V
+7 IF '$DATA(ACDCAND)
DO V1
QUIT
+8 DO TITLE
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO TYPE
+9 DO ZIS
+10 QUIT
V1 ;if visit, no prev defined report used
V11 KILL ^ACDRPTD(ACDRPT,11),ACDRDTR
DO SCREEN
IF $DATA(ACDQUIT)
KILL ACDQUIT
DO DEL
GOTO V
V12 KILL ^ACDRPTD(ACDRPT,12)
SET ACDTCW=0
DO COUNT
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO V11
V13 DO TITLE
IF $DATA(ACDQUIT)
KILL ACDQUIT
GOTO V12
+1 DO SAVE
+2 DO ZIS
+3 QUIT
SCREEN ;
+1 SET ACDCNTL="S"
DO ^ACDRL4
KILL ACDCNTL
+2 QUIT
COUNT ;count only or detailed report
+1 DO COUNT^ACDRL3
+2 QUIT
TITLE ;
+1 IF ACDCTYP="F"
QUIT
+2 IF ACDCTYP="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 ACDQUIT=1
QUIT
+5 IF Y=0
QUIT
+6 SET ACDLENG=$SELECT(ACDTCW:ACDTCW-8,1:60)
+7 IF Y=1
KILL DIR,X,Y
SET DIR(0)="F^3:"_ACDLENG
SET DIR("A")="Enter custom title"
SET DIR("?")=" Enter from 3 to "_ACDLENG_" characters"
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO TITLE
+9 SET ACDTITL=Y
+10 QUIT
SAVE ;
+1 IF $DATA(ACDCAND)
QUIT
+2 ;--- must be a detailed report to be saved
IF ACDCTYP'="D"
QUIT
+3 SET ACDSAVE=""
+4 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Do you wish to SAVE this "_$SELECT('$DATA(ACDEP1):"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 ACDNAME=Y
+10 SET DIE="^ACDRPTD("
SET DA=ACDRPT
SET DR=".02////1;.03///"_ACDNAME_";.06///"_ACDPTVS_";.05///"_ACDCTYP_";.11///"_$GET(ACDRDTR)
IF $DATA(ACDEP1)
SET DR=DR_";.09///"_ACDPACK
DO CALLDIE^ACDRLU1
+11 QUIT
ZIS ;call to XBDBQUE
+1 IF 'ACDTCW
SET ACDTCW=IOM
+2 SET ACDDONE=""
+3 DO SHOW^ACDRLS
DO SHOWP^ACDRLS
DO SHOWR^ACDRLS
+4 DO XIT1
+5 SET XBRP="^ACDRLP"
SET XBRC="^ACDRL1"
SET XBRX="XIT^ACDRL"
SET XBNS="ACD"
+6 DO ^XBDBQUE
+7 DO XIT
+8 QUIT
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
+1 IF $GET(ACDRPT)
IF $DATA(^ACDRPTD(ACDRPT,0))
IF '$PIECE(^ACDRPTD(ACDRPT,0),U,2)
SET DIK="^ACDRPTD("
SET DA=ACDRPT
DO ^DIK
KILL DIK,DA,DIC
+2 QUIT
ADD ;
+1 DO ADD^ACDRL01
+2 QUIT
XIT ;
+1 DO XIT^ACDRL1
XIT1 ;
+1 DO XIT1^ACDRL1
+2 QUIT
