BMCDSP ; IHS/PHXAO/TMJ - BMC - DISPLAY REFERRAL RECORD ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;
; This routine displays a RCIS REFERRAL record with subordinate
; file entries.
;
START ;
D DEV^BMC
Q:BMCQ
F D REFLOOP Q:BMCQ
D EOJ
Q
;
REFLOOP ; DISPLAY REFERRALS UNTIL DONE
D GETREF
Q:BMCQ
D DISPLAY ; display selected record
U 0
D HDR^BMC
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 #: "
D DIC^BMCFMC
Q:Y<1
S BMCRIEN=+Y
S BMCQ=0
Q
;
DISPLAY ; EP - DISPLAY REFERRAL RECORD AND SUBORDINATE FILE ENTRIES
I $D(IO("Q")) D Q
. S ZTRTN="DISPLAYQ^BMCRDSP",ZTDESC="RCIS REFERRAL DISPLAY",ZTDTH=$H,ZTSAVE("BMC*")=""
. D ^%ZTLOAD
. Q
D DISPLAYQ
Q
;
DISPLAYQ ; EP - FOR TASKMAN
U IO
W @IOF
D:$E(IOST,1,2)="P-" CONF^BMC
W !
S DIC="^BMCREF(",DA=BMCRIEN,DIQ(0)="C"
D DIQ^BMCFMC
D:$E(IOST,1,2)'="P-" PAUSE^BMC
;D DSPDX,DSPPX,DSPCMT
D DSPDX,DSPPX
F BMCCTYP="M","B","C","D" D DSPCMTS
U 0
I $D(ZTQUEUED) D EOJ S ZTREQ="@"
Q
;
DSPDX ; DISPLAY DIAGNOSES
S BMCY=0
F S BMCY=$O(^BMCDX("AD",BMCRIEN,BMCY)) Q:'BMCY D
. S DIC="^BMCDX(",DA=BMCY,DIQ(0)="C"
. D DIQ^BMCFMC
. I $E(IOST,1,2)'="P-" D PAUSE^BMC S:$D(DIRUT) BMCY=99999
Q
;
DSPPX ; DISPLAY PROCEDURES
S BMCY=0
F S BMCY=$O(^BMCPX("AD",BMCRIEN,BMCY)) Q:'BMCY D
. S DIC="^BMCPX(",DA=BMCY,DIQ(0)="C"
. D DIQ^BMCFMC
. I $E(IOST,1,2)'="P-" D PAUSE^BMC S:$D(DIRUT) BMCY=99999
Q
;
DSPCMTS ; DISPLAY COMMENTS
S BMCCMT=0
F S BMCCMT=$O(^BMCCOM("AD",BMCRIEN,BMCCMT)) Q:BMCCMT'?1N.N D
.Q:$P(^BMCCOM(BMCCMT,0),U,5)'=BMCCTYP
.S DA=BMCCMT
.D DSPCMT
Q
DSPCMT ; DISPLAY COMMENTS
Q:'DA
S DIC="^BMCCOM("
D DIQ^BMCFMC
D:$E(IOST,1,2)'="P-" PAUSE^BMC
Q
;
EOJ ;
D:IO'=IO(0) ^%ZISC
D ^BMCKILL
Q
BMCDSP ; IHS/PHXAO/TMJ - BMC - DISPLAY REFERRAL RECORD ;
+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 ;
START ;
+1 DO DEV^BMC
+2 IF BMCQ
QUIT
+3 FOR
DO REFLOOP
IF BMCQ
QUIT
+4 DO EOJ
+5 QUIT
+6 ;
REFLOOP ; DISPLAY REFERRALS UNTIL DONE
+1 DO GETREF
+2 IF BMCQ
QUIT
+3 ; display selected record
DO DISPLAY
+4 USE 0
+5 DO HDR^BMC
+6 QUIT
+7 ;
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 DO DIC^BMCFMC
+5 IF Y<1
QUIT
+6 SET BMCRIEN=+Y
+7 SET BMCQ=0
+8 QUIT
+9 ;
DISPLAY ; EP - DISPLAY REFERRAL RECORD AND SUBORDINATE FILE ENTRIES
+1 IF $DATA(IO("Q"))
Begin DoDot:1
+2 SET ZTRTN="DISPLAYQ^BMCRDSP"
SET ZTDESC="RCIS REFERRAL DISPLAY"
SET ZTDTH=$HOROLOG
SET ZTSAVE("BMC*")=""
+3 DO ^%ZTLOAD
+4 QUIT
End DoDot:1
QUIT
+5 DO DISPLAYQ
+6 QUIT
+7 ;
DISPLAYQ ; EP - FOR TASKMAN
+1 USE IO
+2 WRITE @IOF
+3 IF $EXTRACT(IOST,1,2)="P-"
DO CONF^BMC
+4 WRITE !
+5 SET DIC="^BMCREF("
SET DA=BMCRIEN
SET DIQ(0)="C"
+6 DO DIQ^BMCFMC
+7 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
+8 ;D DSPDX,DSPPX,DSPCMT
+9 DO DSPDX
DO DSPPX
+10 FOR BMCCTYP="M","B","C","D"
DO DSPCMTS
+11 USE 0
+12 IF $DATA(ZTQUEUED)
DO EOJ
SET ZTREQ="@"
+13 QUIT
+14 ;
DSPDX ; DISPLAY DIAGNOSES
+1 SET BMCY=0
+2 FOR
SET BMCY=$ORDER(^BMCDX("AD",BMCRIEN,BMCY))
IF 'BMCY
QUIT
Begin DoDot:1
+3 SET DIC="^BMCDX("
SET DA=BMCY
SET DIQ(0)="C"
+4 DO DIQ^BMCFMC
+5 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
IF $DATA(DIRUT)
SET BMCY=99999
End DoDot:1
+6 QUIT
+7 ;
DSPPX ; DISPLAY PROCEDURES
+1 SET BMCY=0
+2 FOR
SET BMCY=$ORDER(^BMCPX("AD",BMCRIEN,BMCY))
IF 'BMCY
QUIT
Begin DoDot:1
+3 SET DIC="^BMCPX("
SET DA=BMCY
SET DIQ(0)="C"
+4 DO DIQ^BMCFMC
+5 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
IF $DATA(DIRUT)
SET BMCY=99999
End DoDot:1
+6 QUIT
+7 ;
DSPCMTS ; DISPLAY COMMENTS
+1 SET BMCCMT=0
+2 FOR
SET BMCCMT=$ORDER(^BMCCOM("AD",BMCRIEN,BMCCMT))
IF BMCCMT'?1N.N
QUIT
Begin DoDot:1
+3 IF $PIECE(^BMCCOM(BMCCMT,0),U,5)'=BMCCTYP
QUIT
+4 SET DA=BMCCMT
+5 DO DSPCMT
End DoDot:1
+6 QUIT
DSPCMT ; DISPLAY COMMENTS
+1 IF 'DA
QUIT
+2 SET DIC="^BMCCOM("
+3 DO DIQ^BMCFMC
+4 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^BMC
+5 QUIT
+6 ;
EOJ ;
+1 IF IO'=IO(0)
DO ^%ZISC
+2 DO ^BMCKILL
+3 QUIT
