BMCRL ; IHS/PHXAO/TMJ - PCC REFERRAL GENERAL RETRIEVAL DRIVER ROUTINE ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;IHS/ITSC/FCJ ADD TST FOR DATE RANGE IN CANNED REPORT
;IHS/ITSC/FCJ ADDED REF TYPE, VAR BMCTYPR: PRIMARY, SECONDARY BOTH
;
START ;
K BMCQUIT ;--- this variable controls whether or not a user terminated input
TYPE ;--- get type of report (patient, date range or search template)
S BMCPTVS="R"
D INFORM^BMCRL01
S (BMCPCNT,BMCPTCT)=0 ;BMCPTCT -- pt total for # of "V"isits
K BMCTYPE ;--- just in case variable left around
D PROCESS,XIT
Q
PROCESS ;process lister
K BMCCAND
S DIR(0)="S^P:A Previously defined report;N:Create a New Report",DIR("A")="Which type of report do you wish to generate",DIR("B")="N" K DA D ^DIR K DIR
I $D(DIRUT) D XIT Q
I Y="P" S BMCCAND=1
D ADD I $D(BMCQUIT) D DEL K BMCQUIT Q
I '$D(BMCCAND) D RTYP Q:$D(DIRUT) D PP1 Q
D CAN I $D(DIRUT) K DIRUT,BMCR("CR") G TYPE
D TITLE I $D(BMCQUIT) K BMCQUIT G TYPE
D ZIS
Q
RTYP ;EP;4.0 IHS/ITSC/FCJ ADDED NEXT SECTION FOR TYPE OF REFERRAL
S DIR(0)="S^P:Primary Referrals;S:Secondary Referrals;B:Both"
S DIR("A")="Include Which type of Referrals in the report",DIR("B")="B" K DA D ^DIR K DIR
Q:$D(DIRUT)
S BMCTYPR=Y
Q
PP1 ;if patient, no prev defined report used
PP11 K ^BMCRTMP(BMCRPT,11) D SCREEN I $D(BMCQUIT) K BMCQUIT D DEL G TYPE
PP12 K ^BMCRTMP(BMCRPT,12) S BMCTCW=0 D COUNT I $D(BMCQUIT) K BMCQUIT G PP11
PP13 D TITLE I $D(BMCQUIT) K BMCQUIT G PP12
D SAVE,ZIS
Q
SCREEN ;
S BMCCNTL="S" D ^BMCRL4
Q
COUNT ;count only or detailed report
D COUNT^BMCRL3
Q
TITLE ;
D TITLE^BMCRL3
Q
SAVE ;
D SAVE^BMCRL3
Q
CAN ;TEST FOR DATE RANGE FIELDS ON CANNED REPORT AND PRIM/SEC REF
D DTTST^BMCRL3
Q
ZIS ;call to XBDBQUE
K BMCOPT
I 'BMCTCW S BMCTCW=IOM
S BMCDONE=""
D SHOW^BMCRLS,SHOWP^BMCRLS,SHOWR^BMCRLS
D XIT1
I BMCCTYP="D"!(BMCCTYP="S")!(BMCCTYP="N") D
.W ! 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 BMCQUIT="" Q
.S BMCOPT=Y
G:$G(BMCQUIT) SAVE
I $G(BMCOPT)="B" D BROWSE,XIT Q
S XBRP="^BMCRLP",XBRC="^BMCRL1",XBRX="XIT^BMCRL",XBNS="BMC"
D ^XBDBQUE
D XIT
Q
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
I $G(BMCRPT),$D(^BMCRTMP(BMCRPT,0)),'$P(^BMCRTMP(BMCRPT,0),U,2) S DIK="^BMCRTMP(",DA=BMCRPT D ^DIK K DIK,DA,DIC
Q
ADD ;
D ADD^BMCRL01
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^BMCRLP"")"
S XBRC="^BMCRL1",XBRX="XIT^BMCRL",XBIOP=0 D ^XBDBQUE
Q
XIT ;EP - CALLED FROM BMCRL
K BMCBD,BMCBDD,BMCED,BMCEDD,BMCSD,BMCSORT,BMCSORV,BMCTCW,BMCRPT,BMCLHDR,BMCDISP,%H,BMCET,BMCLINE,BMCPRNM,BMCPRNT,BMCSKIP,BMCTYPE,BMCSPAG,BMCEN1,BMCSEAT,BMCPTVS,BMC,BMCCAND,BMCHDR,BMCHEAD,BMCSPEC,BMCOPT
K BMCCTYP,BMCFLG,BMCG,BMCNAME,BMCNIFN,BMCSAVE,BMCTITL,BMCQUIT,BMCPCNT,BMCQFLG,BMCPTCT,BMCTL,BMCSRTR,BMCSRTV,BMCNSRT,BMCTYPR
K C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX
K BMCR("CR")
XIT1 ;EP
K BMCANS,BMCBTH,BMCC,BMCCNT,BMCCRIT,BMCCUT,BMCD,BMCDISP,BMCDONE,BMCHIGH,BMCI,BMCJOB,BMCQMAN,BMCSEL,BMCTEXT,BMCVAR,BMCSKIP,BMCPRNT,BMCPRNM,BMCLINE,BMCRCNT,BMCSCNT,BMCDFET,BMCY,DFN
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BMCPACK,BMCEP1,BMCEP2,D,BMCLENG,BMCLHDR,BMCSAVE
Q
BMCRL ; IHS/PHXAO/TMJ - PCC REFERRAL GENERAL RETRIEVAL DRIVER ROUTINE ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;IHS/ITSC/FCJ ADD TST FOR DATE RANGE IN CANNED REPORT
+3 ;IHS/ITSC/FCJ ADDED REF TYPE, VAR BMCTYPR: PRIMARY, SECONDARY BOTH
+4 ;
START ;
+1 ;--- this variable controls whether or not a user terminated input
KILL BMCQUIT
TYPE ;--- get type of report (patient, date range or search template)
+1 SET BMCPTVS="R"
+2 DO INFORM^BMCRL01
+3 ;BMCPTCT -- pt total for # of "V"isits
SET (BMCPCNT,BMCPTCT)=0
+4 ;--- just in case variable left around
KILL BMCTYPE
+5 DO PROCESS
DO XIT
+6 QUIT
PROCESS ;process lister
+1 KILL BMCCAND
+2 SET DIR(0)="S^P:A Previously defined report;N:Create a New Report"
SET DIR("A")="Which type of report do you wish to generate"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO XIT
QUIT
+4 IF Y="P"
SET BMCCAND=1
+5 DO ADD
IF $DATA(BMCQUIT)
DO DEL
KILL BMCQUIT
QUIT
+6 IF '$DATA(BMCCAND)
DO RTYP
IF $DATA(DIRUT)
QUIT
DO PP1
QUIT
+7 DO CAN
IF $DATA(DIRUT)
KILL DIRUT,BMCR("CR")
GOTO TYPE
+8 DO TITLE
IF $DATA(BMCQUIT)
KILL BMCQUIT
GOTO TYPE
+9 DO ZIS
+10 QUIT
RTYP ;EP;4.0 IHS/ITSC/FCJ ADDED NEXT SECTION FOR TYPE OF REFERRAL
+1 SET DIR(0)="S^P:Primary Referrals;S:Secondary Referrals;B:Both"
+2 SET DIR("A")="Include Which type of Referrals in the report"
SET DIR("B")="B"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET BMCTYPR=Y
+5 QUIT
PP1 ;if patient, no prev defined report used
PP11 KILL ^BMCRTMP(BMCRPT,11)
DO SCREEN
IF $DATA(BMCQUIT)
KILL BMCQUIT
DO DEL
GOTO TYPE
PP12 KILL ^BMCRTMP(BMCRPT,12)
SET BMCTCW=0
DO COUNT
IF $DATA(BMCQUIT)
KILL BMCQUIT
GOTO PP11
PP13 DO TITLE
IF $DATA(BMCQUIT)
KILL BMCQUIT
GOTO PP12
+1 DO SAVE
DO ZIS
+2 QUIT
SCREEN ;
+1 SET BMCCNTL="S"
DO ^BMCRL4
+2 QUIT
COUNT ;count only or detailed report
+1 DO COUNT^BMCRL3
+2 QUIT
TITLE ;
+1 DO TITLE^BMCRL3
+2 QUIT
SAVE ;
+1 DO SAVE^BMCRL3
+2 QUIT
CAN ;TEST FOR DATE RANGE FIELDS ON CANNED REPORT AND PRIM/SEC REF
+1 DO DTTST^BMCRL3
+2 QUIT
ZIS ;call to XBDBQUE
+1 KILL BMCOPT
+2 IF 'BMCTCW
SET BMCTCW=IOM
+3 SET BMCDONE=""
+4 DO SHOW^BMCRLS
DO SHOWP^BMCRLS
DO SHOWR^BMCRLS
+5 DO XIT1
+6 IF BMCCTYP="D"!(BMCCTYP="S")!(BMCCTYP="N")
Begin DoDot:1
+7 WRITE !
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
+8 IF $DATA(DIRUT)
SET BMCQUIT=""
QUIT
+9 SET BMCOPT=Y
End DoDot:1
+10 IF $GET(BMCQUIT)
GOTO SAVE
+11 IF $GET(BMCOPT)="B"
DO BROWSE
DO XIT
QUIT
+12 SET XBRP="^BMCRLP"
SET XBRC="^BMCRL1"
SET XBRX="XIT^BMCRL"
SET XBNS="BMC"
+13 DO ^XBDBQUE
+14 DO XIT
+15 QUIT
DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
+1 IF $GET(BMCRPT)
IF $DATA(^BMCRTMP(BMCRPT,0))
IF '$PIECE(^BMCRTMP(BMCRPT,0),U,2)
SET DIK="^BMCRTMP("
SET DA=BMCRPT
DO ^DIK
KILL DIK,DA,DIC
+2 QUIT
ADD ;
+1 DO ADD^BMCRL01
+2 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^BMCRLP"")"
+2 SET XBRC="^BMCRL1"
SET XBRX="XIT^BMCRL"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
XIT ;EP - CALLED FROM BMCRL
+1 KILL BMCBD,BMCBDD,BMCED,BMCEDD,BMCSD,BMCSORT,BMCSORV,BMCTCW,BMCRPT,BMCLHDR,BMCDISP,%H,BMCET,BMCLINE,BMCPRNM,BMCPRNT,BMCSKIP,BMCTYPE,BMCSPAG,BMCEN1,BMCSEAT,BMCPTVS,BMC,BMCCAND,BMCHDR,BMCHEAD,BMCSPEC,BMCOPT
+2 KILL BMCCTYP,BMCFLG,BMCG,BMCNAME,BMCNIFN,BMCSAVE,BMCTITL,BMCQUIT,BMCPCNT,BMCQFLG,BMCPTCT,BMCTL,BMCSRTR,BMCSRTV,BMCNSRT,BMCTYPR
+3 KILL C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX
+4 KILL BMCR("CR")
XIT1 ;EP
+1 KILL BMCANS,BMCBTH,BMCC,BMCCNT,BMCCRIT,BMCCUT,BMCD,BMCDISP,BMCDONE,BMCHIGH,BMCI,BMCJOB,BMCQMAN,BMCSEL,BMCTEXT,BMCVAR,BMCSKIP,BMCPRNT,BMCPRNM,BMCLINE,BMCRCNT,BMCSCNT,BMCDFET,BMCY,DFN
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,BMCPACK,BMCEP1,BMCEP2,D,BMCLENG,BMCLHDR,BMCSAVE
+3 QUIT
