- 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
