BCHUDISP.m

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