- BCHRL ; IHS/CMI/LAB - CHR GENERAL RETRIEVAL DRIVER ;
- ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- 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 BCHQUIT
- TYPE ;--- get type of report (patient, date range or search template)
- D INFORM^BCHRL01
- K DIR,X,Y S DIR(0)="S^S:Search Template"_$S(BCHPTVS="V":";D:Date Range",1:";P:Patient File"),DIR("A")="Select and Print "_$S(BCHPTVS="P":"Patient ",1:"Encounter ")_"List from" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- G:$D(DIRUT) XIT
- S BCHTYPE=Y
- D @BCHTYPE
- D XIT
- Q
- P ;patient lister
- D ADD I $D(BCHQUIT) D DEL K BCHQUIT G TYPE
- I '$D(BCHCAND) D P1 Q
- I $D(BCHCAND),$P(^BCHTRPT(BCHRPT,0),U,11) D I $D(DIRUT)!'($D(BCHBDD))!('$D(BCHEDD)) Q
- .S BCHRDTR=""
- .W !!,"You have selected at least one item that requires a date range selection."
- .D GETDATES
- D TITLE I $D(BCHQUIT) K BCHQUIT G TYPE
- D ZIS
- Q
- P1 ;if patient, no prev defined report used
- P11 K ^BCHTRPT(BCHRPT,11),BCHRDTR D SCREEN I $D(BCHQUIT) K BCHQUIT D DEL G TYPE
- I $D(BCHRDTR) D
- .W !!,"You have selected at least one item that requires a date range selection."
- .D GETDATES
- P12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G P11
- P13 D TITLE I $D(BCHQUIT) K BCHQUIT G P12
- D SAVE
- D ZIS
- Q
- S ;--- search template
- D S0
- Q:$D(BCHQUIT)
- S1 ;EP
- D ADD I $D(BCHQUIT) G S
- S12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G S
- S13 D TITLE I $D(BCHQUIT) K BCHQUIT G S12
- D ZIS
- Q
- S0 ;
- S:BCHPTVS="V" DIC("S")="I $P(^(0),U,4)=9000010" S:BCHPTVS="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 BCHQUIT="" Q
- S BCHSEAT=+Y
- ;
- Q
- D ;
- GETDATES ;
- BD ;get beginning date
- W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Date of Service for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) D DEL G TYPE
- S BCHBD=Y
- ED ;get ending date
- W ! K DIR,X,Y S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter Ending Date of Service for search" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G BD
- S BCHED=Y
- S X1=BCHBD,X2=-1 D C^%DTC S BCHD=X S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
- Q:$D(BCHRDTR)
- D ADD I $D(BCHQUIT) D DEL K BCHQUIT G D
- I '$D(BCHCAND) D D1 Q
- D TITLE I $D(BCHQUIT) K BCHQUIT G TYPE
- D ZIS
- Q
- D1 ;if visit, no prev defined report used
- D11 K ^BCHTRPT(BCHRPT,11),BCHRDTR D SCREEN I $D(BCHQUIT) K BCHQUIT D DEL G D
- D12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G D11
- D13 D TITLE I $D(BCHQUIT) K BCHQUIT G D12
- D SAVE
- D ZIS
- Q
- SCREEN ;
- D SCREEN^BCHRL3
- Q
- COUNT ;count only or detailed report
- D COUNT^BCHRL3
- Q
- TITLE ;
- Q:BCHCTYP="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 BCHQUIT=1 Q
- Q:Y=0
- S BCHLENG=$S(BCHTCW:BCHTCW-8,1:60)
- I Y=1 K DIR,X,Y S DIR(0)="F^3:"_BCHLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_BCHLENG_" characters" D ^DIR K DIR
- G:$D(DIRUT) TITLE
- S BCHTITL=Y
- Q
- SAVE ;
- Q:$D(BCHCAND)
- Q:BCHCTYP'="D" ;--- must be a detailed report to be saved
- S BCHSAVE=""
- K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(BCHEP1):"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 BCHNAME=Y
- S DIE="^BCHTRPT(",DA=BCHRPT,DR=".02////1;.03///"_BCHNAME_";.06///"_BCHPTVS_";.05///"_BCHCTYP_";.11///"_$G(BCHRDTR) S:$D(BCHEP1) DR=DR_";.09///"_BCHPACK D CALLDIE^BCHUTIL
- Q
- ZIS ;call to XBDBQUE
- I 'BCHTCW S BCHTCW=IOM
- S BCHDONE=""
- D SHOW^BCHRLS,SHOWP^BCHRLS,SHOWR^BCHRLS
- D XIT1
- S XBRP="^BCHRLP",XBRC="^BCHRL1",XBRX="XIT^BCHRL",XBNS="BCH"
- D ^XBDBQUE
- D XIT
- Q
- DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
- I $G(BCHRPT),$D(^BCHTRPT(BCHRPT,0)),'$P(^BCHTRPT(BCHRPT,0),U,2) S DIK="^BCHTRPT(",DA=BCHRPT D ^DIK K DIK,DA,DIC
- Q
- ADD ;
- D ADD^BCHRL01
- Q
- XIT ;
- D XIT^BCHRL1
- XIT1 ;
- D XIT1^BCHRL1
- Q
- BCHRL ; IHS/CMI/LAB - CHR GENERAL RETRIEVAL DRIVER ;
- +1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- 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 BCHQUIT
- TYPE ;--- get type of report (patient, date range or search template)
- +1 DO INFORM^BCHRL01
- +2 KILL DIR,X,Y
- SET DIR(0)="S^S:Search Template"_$SELECT(BCHPTVS="V":";D:Date Range",1:";P:Patient File")
- SET DIR("A")="Select and Print "_$SELECT(BCHPTVS="P":"Patient ",1:"Encounter ")_"List from"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- GOTO XIT
- +4 SET BCHTYPE=Y
- +5 DO @BCHTYPE
- +6 DO XIT
- +7 QUIT
- P ;patient lister
- +1 DO ADD
- IF $DATA(BCHQUIT)
- DO DEL
- KILL BCHQUIT
- GOTO TYPE
- +2 IF '$DATA(BCHCAND)
- DO P1
- QUIT
- +3 IF $DATA(BCHCAND)
- IF $PIECE(^BCHTRPT(BCHRPT,0),U,11)
- Begin DoDot:1
- +4 SET BCHRDTR=""
- +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(BCHBDD))!('$DATA(BCHEDD))
- QUIT
- +7 DO TITLE
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO TYPE
- +8 DO ZIS
- +9 QUIT
- P1 ;if patient, no prev defined report used
- P11 KILL ^BCHTRPT(BCHRPT,11),BCHRDTR
- DO SCREEN
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- DO DEL
- GOTO TYPE
- +1 IF $DATA(BCHRDTR)
- 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 ^BCHTRPT(BCHRPT,12)
- SET BCHTCW=0
- DO COUNT
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO P11
- P13 DO TITLE
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO P12
- +1 DO SAVE
- +2 DO ZIS
- +3 QUIT
- S ;--- search template
- +1 DO S0
- +2 IF $DATA(BCHQUIT)
- QUIT
- S1 ;EP
- +1 DO ADD
- IF $DATA(BCHQUIT)
- GOTO S
- S12 KILL ^BCHTRPT(BCHRPT,12)
- SET BCHTCW=0
- DO COUNT
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO S
- S13 DO TITLE
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO S12
- +1 DO ZIS
- +2 QUIT
- S0 ;
- +1 IF BCHPTVS="V"
- SET DIC("S")="I $P(^(0),U,4)=9000010"
- IF BCHPTVS="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 BCHQUIT=""
- QUIT
- +3 SET BCHSEAT=+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 Date of Service for search"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- DO DEL
- GOTO TYPE
- +3 SET BCHBD=Y
- ED ;get ending date
- +1 WRITE !
- KILL DIR,X,Y
- SET DIR(0)="D^"_BCHBD_":DT:EP"
- SET DIR("A")="Enter Ending Date of Service for search"
- SET Y=BCHBD
- DO DD^%DT
- SET DIR("B")=Y
- SET Y=""
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO BD
- +3 SET BCHED=Y
- +4 SET X1=BCHBD
- SET X2=-1
- DO C^%DTC
- SET BCHD=X
- SET Y=BCHBD
- DO DD^%DT
- SET BCHBDD=Y
- SET Y=BCHED
- DO DD^%DT
- SET BCHEDD=Y
- +5 IF $DATA(BCHRDTR)
- QUIT
- +6 DO ADD
- IF $DATA(BCHQUIT)
- DO DEL
- KILL BCHQUIT
- GOTO D
- +7 IF '$DATA(BCHCAND)
- DO D1
- QUIT
- +8 DO TITLE
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO TYPE
- +9 DO ZIS
- +10 QUIT
- D1 ;if visit, no prev defined report used
- D11 KILL ^BCHTRPT(BCHRPT,11),BCHRDTR
- DO SCREEN
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- DO DEL
- GOTO D
- D12 KILL ^BCHTRPT(BCHRPT,12)
- SET BCHTCW=0
- DO COUNT
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO D11
- D13 DO TITLE
- IF $DATA(BCHQUIT)
- KILL BCHQUIT
- GOTO D12
- +1 DO SAVE
- +2 DO ZIS
- +3 QUIT
- SCREEN ;
- +1 DO SCREEN^BCHRL3
- +2 QUIT
- COUNT ;count only or detailed report
- +1 DO COUNT^BCHRL3
- +2 QUIT
- TITLE ;
- +1 IF BCHCTYP="T"
- QUIT
- +2 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
- +3 IF $DATA(DIRUT)
- SET BCHQUIT=1
- QUIT
- +4 IF Y=0
- QUIT
- +5 SET BCHLENG=$SELECT(BCHTCW:BCHTCW-8,1:60)
- +6 IF Y=1
- KILL DIR,X,Y
- SET DIR(0)="F^3:"_BCHLENG
- SET DIR("A")="Enter custom title"
- SET DIR("?")=" Enter from 3 to "_BCHLENG_" characters"
- DO ^DIR
- KILL DIR
- +7 IF $DATA(DIRUT)
- GOTO TITLE
- +8 SET BCHTITL=Y
- +9 QUIT
- SAVE ;
- +1 IF $DATA(BCHCAND)
- QUIT
- +2 ;--- must be a detailed report to be saved
- IF BCHCTYP'="D"
- QUIT
- +3 SET BCHSAVE=""
- +4 KILL DIR,X,Y
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to SAVE this "_$SELECT('$DATA(BCHEP1):"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 BCHNAME=Y
- +10 SET DIE="^BCHTRPT("
- SET DA=BCHRPT
- SET DR=".02////1;.03///"_BCHNAME_";.06///"_BCHPTVS_";.05///"_BCHCTYP_";.11///"_$GET(BCHRDTR)
- IF $DATA(BCHEP1)
- SET DR=DR_";.09///"_BCHPACK
- DO CALLDIE^BCHUTIL
- +11 QUIT
- ZIS ;call to XBDBQUE
- +1 IF 'BCHTCW
- SET BCHTCW=IOM
- +2 SET BCHDONE=""
- +3 DO SHOW^BCHRLS
- DO SHOWP^BCHRLS
- DO SHOWR^BCHRLS
- +4 DO XIT1
- +5 SET XBRP="^BCHRLP"
- SET XBRC="^BCHRL1"
- SET XBRX="XIT^BCHRL"
- SET XBNS="BCH"
- +6 DO ^XBDBQUE
- +7 DO XIT
- +8 QUIT
- DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
- +1 IF $GET(BCHRPT)
- IF $DATA(^BCHTRPT(BCHRPT,0))
- IF '$PIECE(^BCHTRPT(BCHRPT,0),U,2)
- SET DIK="^BCHTRPT("
- SET DA=BCHRPT
- DO ^DIK
- KILL DIK,DA,DIC
- +2 QUIT
- ADD ;
- +1 DO ADD^BCHRL01
- +2 QUIT
- XIT ;
- +1 DO XIT^BCHRL1
- XIT1 ;
- +1 DO XIT1^BCHRL1
- +2 QUIT