BMCSPDSP ; IHS/PHXAO/TMJ - BMC - DISPLAY SECONDARY PROVIDER RECORDS FOR A SPECIFIC PT ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;
; This routine displays a RCIS REFERRAL record with subordinate
; file entries.
;4.0 FCJ Changed to pull SR info fr RCIS REF file AND prt sec ref #
;
START ;
;
GETPAT ;EP GET- PATIENT
W !
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S BMCPAT=+Y
;
ASK ;Ask for All Referrals or a Specific Referral
S DIR(0)="SO^A:Display ALL Referrals;S:Display a Specific Referral",DIR("A")="Report should include: "
S DIR("?")="If you wish to include only a Specific Referral - enter 'S'. To include ALL Referrals enter an 'A'. All Secondary Referrals will be Display for each Referral printed." D ^DIR K DIR
I $D(DIRUT) S BMCQUIT="" G EOJ
;I Y<0 G EOJ
I Y="A" S BMCALL=""
I Y="S" S BMCSPEC=""
I $D(BMCSPEC) D G EOJ
. D GETREF
. I $D(BMCQUIT) Q
. D DSPSPEC
I $D(BMCALL) D DSPALL G EOJ
;
Q
;
;
GETREF ; GET REFERRAL
S BMCQ=1
W !
S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "
S DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"
D ^DIC K DIC
I $D(DIRUT) S BMCQUIT="" G EOJ
I Y<0 G EOJ
S BMCRIEN=+Y
S BMCQ=0
Q
;
;
DSPALL ; DISPLAY ALL SECONDARY PROVIDERS FOR ALL REFERRALS FOR THIS PT
; 4.0 IHS/ITSC/FCJ;REWROTE SECTION
S BMCRIEN=0,BMCT=0
F S BMCRIEN=$O(^BMCREF("D",BMCPAT,BMCRIEN)) Q:BMCRIEN'?1N.N D
.S BMCRNUMB=$P(^BMCREF(BMCRIEN,0),U,2)
.Q:'$D(^BMCREF("S",BMCRNUMB))!$D(BMCTMP(BMCRNUMB))
.S BMCY=0,BMCT=1,BMCTMP(BMCRNUMB)=""
.F S BMCY=$O(^BMCREF("S",BMCRNUMB,BMCY)) Q:BMCY'?1A.1N D Q:$D(DIRUT)
..S BMCSRIEN=0
..S BMCSRIEN=$O(^BMCREF("S",BMCRNUMB,BMCY,BMCSRIEN))
.. S DIC="^BMCREF(",DA=BMCSRIEN,DIQ(0)="C"
..W !,"SECONDARY REFERRAL #:",$P(^BMCREF(DA,0),U,2),$P(^BMCREF(DA,1),U)
.. D DIQ^BMCFMC
.. I $E(IOST,1,2)'="P-" D PAUSE^BMC
I BMCT=0 W !!,?10,"**NO SECONDARY REFERRALS ATTACHED TO THIS PATIENT'S REFERRALS**",!! D PAUSE^BMC Q
Q
;
DSPSPEC ; DISPLAY SPECIFIC REFERRAL FOR A SPECIFIC PATIENT
; 4.0 IHS/ITSC/FCJ;REWROTE SECTION
Q:'$D(BMCRIEN)
S DIC="^BMCREF(",DA=BMCRIEN,DIQ(0)="C"
W !,"SECONDARY REFERRAL #:",$P(^BMCREF(DA,0),U,2),$P(^BMCREF(DA,1),U)
D DIQ^BMCFMC
I $E(IOST,1,2)'="P-" D PAUSE^BMC
Q
;
;
EOJ ;
D:IO'=IO(0) ^%ZISC
K BMCALL,BMCSPEC,BMCPAT,BMCQUIT,BMCRIEN,BMCSRIEN,BMCT,BMCTMP
D ^BMCKILL
Q
BMCSPDSP ; IHS/PHXAO/TMJ - BMC - DISPLAY SECONDARY PROVIDER RECORDS FOR A SPECIFIC PT ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;
+3 ; This routine displays a RCIS REFERRAL record with subordinate
+4 ; file entries.
+5 ;4.0 FCJ Changed to pull SR info fr RCIS REF file AND prt sec ref #
+6 ;
START ;
+1 ;
GETPAT ;EP GET- PATIENT
+1 WRITE !
+2 SET APCDPAT=""
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y<0
QUIT
+5 SET BMCPAT=+Y
+6 ;
ASK ;Ask for All Referrals or a Specific Referral
+1 SET DIR(0)="SO^A:Display ALL Referrals;S:Display a Specific Referral"
SET DIR("A")="Report should include: "
+2 SET DIR("?")="If you wish to include only a Specific Referral - enter 'S'. To include ALL Referrals enter an 'A'. All Secondary Referrals will be Display for each Referral printed."
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BMCQUIT=""
GOTO EOJ
+4 ;I Y<0 G EOJ
+5 IF Y="A"
SET BMCALL=""
+6 IF Y="S"
SET BMCSPEC=""
+7 IF $DATA(BMCSPEC)
Begin DoDot:1
+8 DO GETREF
+9 IF $DATA(BMCQUIT)
QUIT
+10 DO DSPSPEC
End DoDot:1
GOTO EOJ
+11 IF $DATA(BMCALL)
DO DSPALL
GOTO EOJ
+12 ;
+13 QUIT
+14 ;
+15 ;
GETREF ; GET REFERRAL
+1 SET BMCQ=1
+2 WRITE !
+3 SET DIC="^BMCREF("
SET DIC(0)="AEMQ"
SET DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "
+4 SET DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"
+5 DO ^DIC
KILL DIC
+6 IF $DATA(DIRUT)
SET BMCQUIT=""
GOTO EOJ
+7 IF Y<0
GOTO EOJ
+8 SET BMCRIEN=+Y
+9 SET BMCQ=0
+10 QUIT
+11 ;
+12 ;
DSPALL ; DISPLAY ALL SECONDARY PROVIDERS FOR ALL REFERRALS FOR THIS PT
+1 ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION
+2 SET BMCRIEN=0
SET BMCT=0
+3 FOR
SET BMCRIEN=$ORDER(^BMCREF("D",BMCPAT,BMCRIEN))
IF BMCRIEN'?1N.N
QUIT
Begin DoDot:1
+4 SET BMCRNUMB=$PIECE(^BMCREF(BMCRIEN,0),U,2)
+5 IF '$DATA(^BMCREF("S",BMCRNUMB))!$DATA(BMCTMP(BMCRNUMB))
QUIT
+6 SET BMCY=0
SET BMCT=1
SET BMCTMP(BMCRNUMB)=""
+7 FOR
SET BMCY=$ORDER(^BMCREF("S",BMCRNUMB,BMCY))
IF BMCY'?1A.1N
QUIT
Begin DoDot:2
+8 SET BMCSRIEN=0
+9 SET BMCSRIEN=$ORDER(^BMCREF("S",BMCRNUMB,BMCY,BMCSRIEN))
+10 SET DIC="^BMCREF("
SET DA=BMCSRIEN
SET DIQ(0)="C"
+11 WRITE !,"SECONDARY REFERRAL #:",$PIECE(^BMCREF(DA,0),U,2),$PIECE(^BMCREF(DA,1),U)
+12 DO DIQ^BMCFMC
+13 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
End DoDot:2
IF $DATA(DIRUT)
QUIT
End DoDot:1
+14 IF BMCT=0
WRITE !!,?10,"**NO SECONDARY REFERRALS ATTACHED TO THIS PATIENT'S REFERRALS**",!!
DO PAUSE^BMC
QUIT
+15 QUIT
+16 ;
DSPSPEC ; DISPLAY SPECIFIC REFERRAL FOR A SPECIFIC PATIENT
+1 ; 4.0 IHS/ITSC/FCJ;REWROTE SECTION
+2 IF '$DATA(BMCRIEN)
QUIT
+3 SET DIC="^BMCREF("
SET DA=BMCRIEN
SET DIQ(0)="C"
+4 WRITE !,"SECONDARY REFERRAL #:",$PIECE(^BMCREF(DA,0),U,2),$PIECE(^BMCREF(DA,1),U)
+5 DO DIQ^BMCFMC
+6 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
+7 QUIT
+8 ;
+9 ;
EOJ ;
+1 IF IO'=IO(0)
DO ^%ZISC
+2 KILL BMCALL,BMCSPEC,BMCPAT,BMCQUIT,BMCRIEN,BMCSRIEN,BMCT,BMCTMP
+3 DO ^BMCKILL
+4 QUIT
