- 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
