BCHUEDT1.m

BCHUEDT1 ; IHS/CMI/LAB - EDIT A RECORD ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

 D ^BCHUIN

 D GETDATE

 I BCHDATE="" W !!,"No Date entered!" D EOJ Q

 D GETPROV

 K BCHR,BCHRRECS,BCHVRECS D RECLKUP

 I '$G(BCHR) D EOJ Q

 D EDIT

 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

EDIT ;

 S BCHEN1=1

 D DISP^BCHUEDT

 Q

 ;

RECLKUP ;

 D ^BCHULKUP

 Q

EOJ ; END OF JOB

 K BCHPROV,BCHDATE,DFN,BCHODAT,BCHR,BCHEN1

 Q

 ;

BCHUEDT1  ; IHS/CMI/LAB - EDIT A RECORD ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3        DO ^BCHUIN

 +4        DO GETDATE

 +5        IF BCHDATE=""

               WRITE !!,"No Date entered!"

               DO EOJ

               QUIT 

 +6        DO GETPROV

 +7        KILL BCHR,BCHRRECS,BCHVRECS

           DO RECLKUP

 +8        IF '$GET(BCHR)

               DO EOJ

               QUIT 

 +9        DO EDIT

 +10       DO EOJ

 +11       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 

EDIT      ;

 +1        SET BCHEN1=1

 +2        DO DISP^BCHUEDT

 +3        QUIT 

 +4       ;

RECLKUP   ;

 +1        DO ^BCHULKUP

 +2        QUIT 

EOJ       ; END OF JOB

 +1        KILL BCHPROV,BCHDATE,DFN,BCHODAT,BCHR,BCHEN1

 +2        QUIT 

 +3       ;