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
