BCHUDISP ; IHS/CMI/LAB - DISPLAY A RECORD (FILEMAN INQUIRE FORMAT) ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
D GETDATE
I BCHDATE="" W !!,"No Date entered!" D EOJ Q
D GETPROV
K BCHR,BCHVRECS,BCHRRECS D RECLKUP
I '$G(BCHR) D EOJ Q
D FORMAT
I BCHTYPE="" D EOJ Q
I BCHTYPE="S" D DSPLY,EOJ Q
I BCHTYPE="C" D PRINT1^BCHUFPP
D EOJ
Q
GETDATE ; GET DATE OF ENCOUNTER
W !
S BCHDATE=""
S DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter DATE OF SERVICE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
K BCHODAT
S BCHDATE=Y
;
Q
;
GETPROV ;get location of encounter
S BCHPROV=""
S DIC("A")="Enter CHR (if known): ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA
Q:Y<0
S BCHPROV=+Y
Q
DSPLY ;
D EN^BCHUDSP
Q
;
RECLKUP ;
D ^BCHULKUP
Q
EOJ ; END OF JOB
K BCHPROV,BCHDATE,DFN,BCHODAT,BCHR,BCHTYPE
Q
;
EN ;EP called from list manager display a record protocol
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) W !,"No records selected." G EXIT
S BCHR=$O(VALMY(0)) I 'BCHR K BCHR,VALMY,XQORNOD W !,"No record selected." G EXIT
S BCHR=BCHVRECS("IDX",BCHR,BCHR) I 'BCHR K BCHRDEL,BCHR D PAUSE^BCHUTIL1 D EXIT Q
I '$D(^BCHR(BCHR,0)) W !,"Not a valid CHR RECORD." K BCHRDEL,BCHR D PAUSE^BCHUTIL1 D EXIT Q
D FULL^VALM1
D FORMAT
I BCHTYPE="" G DONE
I BCHTYPE="S" D EN^BCHUDSP G DONE
I BCHTYPE="C" D PRINT1^BCHUFPP
DONE D EXIT
Q
FORMAT ;
S BCHTYPE=""
S DIR(0)="S^C:CHR PCC Form Format;S:Standard Display",DIR("A")="Select Print Format",DIR("B")="C" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S BCHTYPE=Y
Q
EXIT ;EP
S VALMBCK="R"
D GATHER^BCHUARL
S VALMCNT=BCHRCNT
D HDR^BCHUAR
K BCHV,BCHF,BCHDR,DFN,BCHR,BCHQUIT,BCHRDEL,BCHV,BCHVDLT,BCHTYPE,BCHPRNM
Q
BCHUDISP ; IHS/CMI/LAB - DISPLAY A RECORD (FILEMAN INQUIRE FORMAT) ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 DO GETDATE
+4 IF BCHDATE=""
WRITE !!,"No Date entered!"
DO EOJ
QUIT
+5 DO GETPROV
+6 KILL BCHR,BCHVRECS,BCHRRECS
DO RECLKUP
+7 IF '$GET(BCHR)
DO EOJ
QUIT
+8 DO FORMAT
+9 IF BCHTYPE=""
DO EOJ
QUIT
+10 IF BCHTYPE="S"
DO DSPLY
DO EOJ
QUIT
+11 IF BCHTYPE="C"
DO PRINT1^BCHUFPP
+12 DO EOJ
+13 QUIT
GETDATE ; GET DATE OF ENCOUNTER
+1 WRITE !
+2 SET BCHDATE=""
+3 SET DIR(0)="DO^:"_DT_":EPT"
SET DIR("A")="Enter DATE OF SERVICE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+6 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+7 KILL BCHODAT
+8 SET BCHDATE=Y
+9 ;
+10 QUIT
+11 ;
GETPROV ;get location of encounter
+1 SET BCHPROV=""
+2 SET DIC("A")="Enter CHR (if known): "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+3 IF Y<0
QUIT
+4 SET BCHPROV=+Y
+5 QUIT
DSPLY ;
+1 DO EN^BCHUDSP
+2 QUIT
+3 ;
RECLKUP ;
+1 DO ^BCHULKUP
+2 QUIT
EOJ ; END OF JOB
+1 KILL BCHPROV,BCHDATE,DFN,BCHODAT,BCHR,BCHTYPE
+2 QUIT
+3 ;
EN ;EP called from list manager display a record protocol
+1 DO EN^VALM2(XQORNOD(0),"OS")
+2 IF '$DATA(VALMY)
WRITE !,"No records selected."
GOTO EXIT
+3 SET BCHR=$ORDER(VALMY(0))
IF 'BCHR
KILL BCHR,VALMY,XQORNOD
WRITE !,"No record selected."
GOTO EXIT
+4 SET BCHR=BCHVRECS("IDX",BCHR,BCHR)
IF 'BCHR
KILL BCHRDEL,BCHR
DO PAUSE^BCHUTIL1
DO EXIT
QUIT
+5 IF '$DATA(^BCHR(BCHR,0))
WRITE !,"Not a valid CHR RECORD."
KILL BCHRDEL,BCHR
DO PAUSE^BCHUTIL1
DO EXIT
QUIT
+6 DO FULL^VALM1
+7 DO FORMAT
+8 IF BCHTYPE=""
GOTO DONE
+9 IF BCHTYPE="S"
DO EN^BCHUDSP
GOTO DONE
+10 IF BCHTYPE="C"
DO PRINT1^BCHUFPP
DONE DO EXIT
+1 QUIT
FORMAT ;
+1 SET BCHTYPE=""
+2 SET DIR(0)="S^C:CHR PCC Form Format;S:Standard Display"
SET DIR("A")="Select Print Format"
SET DIR("B")="C"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET BCHTYPE=Y
+5 QUIT
EXIT ;EP
+1 SET VALMBCK="R"
+2 DO GATHER^BCHUARL
+3 SET VALMCNT=BCHRCNT
+4 DO HDR^BCHUAR
+5 KILL BCHV,BCHF,BCHDR,DFN,BCHR,BCHQUIT,BCHRDEL,BCHV,BCHVDLT,BCHTYPE,BCHPRNM
+6 QUIT
