BARPPY1A.m

BARPPY1A ; IHS/SD/TMM - PREPAYMENT ENTRY - CONT'D ; 05/11/2010

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005

 ;

 ; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.

 ; *********************************************************************

 ;	

NEW() ;EP - extrensic call to establish a new prepayment record

 ; returns 0-lock on file, fm-dt/sec -IEN ; -1 not added

 F I=1:1:5 L +^BARPPAY(DUZ(2)):2 S X=$T Q:X

 I 'X D  Q X

 . W *7,!!,"A/R PREPAYMENT FILE LOCKED, try again",!!

 ;---- Create Pre-Payment record

 K DIC,DR,DA

 S DIC="^BARPPAY(DUZ(2),"

 S DIC(0)="E"

 K DD,DO

 D FILE^DICN

 K DR,DA,DIE

 L -^BARPPAY(DUZ(2))

 Q +Y

 ;

PAD(BARVAR,BARLNG) ; EP

 ; BARVAR = data

 ; BARLNG = length

 ; Right justify, zero fill value BARVAR for length BARLNG

 K BARZERO

 S $P(BARZERO,"0",BARLNG+1)=""

 S BARVAR=BARZERO_BARVAR

 S BARVAR=$E(BARVAR,$L(BARVAR)-(BARLNG-1),$L(BARVAR))

 Q BARVAR

 ;

CARDTYPE(CARD) ;  

 S CARDTYPE=$S(CARD="A":"AMERICAN EXPRESS",CARD="C":"DINERS CLUB",CARD="D":"DISCOVER",CARD="M":"MASTERCARD",CARD="V":"VISA",1:"")

 Q CARDTYPE

 ;

PAYTYPE(PMTYP) ;

 S PAYTYPE=$S(PMTYP="CA":"CASH",PMTYP="CK":"CHECK",PMTYP="CC":"CREDIT CARD",PMTYP="DB":"DEBIT CARD",1:"")

 Q PAYTYPE

 ;

CKOUT() ;  Check DIR values

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$G(BARSTOP) Q 1

 Q 0

 ;

 ; *********************************************************************

HINPTON ;   Hilight when PT NAME field

 I $G(BARPAT)'="",BARPAT'=BARPTI1 D

 . W $$EN^BARVDF("HIN")

 . S HINPTON=1

 Q

 ;

HINPTOFF ;   Turn off Hilight when PT NAME field

 W $$EN^BARVDF("HIF")

 S HINPTON=0

 Q

 ;

HINBLON ;  Hilight DOS fields

 I BARDOSB'="",BARDOSB'=BARPDOS D

 . W $$EN^BARVDF("HIN")

 . S HINBLON=1

 Q

 ;

HINBLOFF ;  Turn off hilight for DOS fields

 W "**",$$EN^BARVDF("HIF")

 S HINBLON=0

 Q

 ;

RECAP ;  Display data for user to review and select next step

 Q:BARSTOP

 W $$EN^BARVDF("IOF"),!        ;Form Feed/Clear screen

 W $$EN^BARVDF("CLR")          ;Clear screen

 S Y=BARPDOS

 D D^DIQ       ;get external date

 D HINBLON

 W !,"1)",?4,"PAYMENT FOR DOS:",?22,Y

 I HINBLON D HINBLOFF

 W !,"2)",?4,"CREDIT: ",?22,"$",$FN(BARAMT,",",2)

 W !!,"3)",?4,"DEPARTMENT:",?22,BARDEPTE

 I BARPMTYP="CA" S BARTMP="CASH^^"

 I BARPMTYP="CK" S BARTMP="CHECK^CHECK NUMBER:^NAME ON CK ACCOUNT:"

 I BARPMTYP="CC" S BARTMP="CREDIT CARD^CARD TYPE:^NAME ON CARD:"

 I BARPMTYP="DB" S BARTMP="DEBIT CARD^CARD TYPE:^NAME ON CARD:"

 W !!,"4)",?4,"PAYMENT TYPE:",?22,$P(BARTMP,U)  ;PAYMENT TYPE line 1

 S BARTMP1=$S(BARPMTYP="CK":BARCK,BARPMTYP="CC":BARCTYPN,BARPMTYP="DB":BARCTYPN,1:"")

 I $P(BARTMP,U)'="CASH" D

 . W !,?4,$P(BARTMP,U,2),?22,BARTMP1  ;PAYMENT TYPE line 2

 . S BARTMP1=$S("^CK^CC^DB^"[BARPMTYP:BARCNAME,1:"")

 . W !,?4,$P(BARTMP,U,3),?22,BARTMP1  ;PAYMENT TYPE line 3

 W !!,"5)",?4,"A/R BILL NUMBER:",?22,$$GET1^DIQ(90050.01,BARBLIEN_",",.01,"E")

 I BARBLIEN'="" D HINPTON      ;hilight patient name when applicable

 W !,?4,"PATIENT NAME:",?22,$S(+BARPAT:$P(^DPT(BARPAT,0),U),1:"")

 I HINPTON D HINPTOFF     ;hilight patient name when applicable

 I BARBLIEN'="" D HINBLON

 S Y=$G(BARDOSB)

 D D^DIQ       ;converts internal FM date to external

 W !,?4,"BILL DOS:",?22,Y

 I HINBLON D HINBLOFF

 D HINPTON

 W !!,"6)",?4,"PATIENT:",?22,BARPTNM1

 I HINPTON D HINPTOFF

CMT  ;Comments

 K BARCMT  ; comments array

 S BARCMT=$L(BARCMTS)

 N SP,W,L,WORD S SP=" ",L=1  ;SP-space; W- WordCtr; L-LINE#

 S BARCMT(1)=""

 F W=1:1 S WORD=$P(BARCMTS,SP,W) Q:WORD=""  D

 . I W>1 S WORD=SP_WORD  ; space betw words

 . I ($L(BARCMT(L))+$L(WORD))'>70 S BARCMT(L)=BARCMT(L)_WORD

 . E  S L=L+1,BARCMT(L)=$E(WORD,2,99)  ; remove leading space

 I BARCMT(1)="" K BARCMT

 W !!,"7)",?4,"COMMENTS:"

 F I=1:1:4 S BARCMT=$O(BARCMT(I)) Q:$G(BARCMT(I))=""  D

 . S BARCMT(5)=BARCMT(I)

 . I BARCMT(I)=1 W "  "

 . E  I $E(BARCMT(5),$L(BARCMT(5)))'=" "&($E(BARCMT(I))'=" ") W " "

 . W BARCMT(I)

 K BARCMT(5)

 ;

FMQ ;  Prompt F/M/Q

 I $G(BARDOSB)'="",BARDOSB'=BARPDOS W !!,?4,$$EN^BARVDF("HIN"),BARNOTE1,$$EN^BARVDF("HIF")

 I $G(BARPAT)'="",BARPAT'=BARPTI1  W $$EN^BARVDF("HIN"),!!,?4,BARNOTE2,$$EN^BARVDF("HIF")

 S BARFILE=""

 W !!

 D RESETDIR^BARPPY01

 S DIR(0)="SA^F:FILE;M:MODIFY;Q:QUIT"

 S DIR("A")="FILE PREPAYMENT?   SELECT (F)ILE, (M)ODIFY, (Q)UIT:  "

 K DA

 D ^DIR

 I $D(DUOUT)!$D(DIROUT) G FMQ

 I $D(DTOUT) Q

 S BARFILE=X

 ;

 ; ---FILE---

 I "Ff"[BARFILE D

 . S BARTMPF="OK"   ;OK to file (No A/R Bill Selected, or A/R Bill selected and matches item 6 PATIENT)

 . I +$G(BARPTI1)=0,(+$G(BARBLIEN)=0) S BARTMPF="NOB"  ;bar*1.8*19 SDR

 . I $G(BARPAT)'="",BARPAT'=BARPTI1 S BARTMPF="NOK"  ;A/R Bill selected and does not match item 6 PATIENT)

 ;start new code bar*1.8*19 SDR

 I "Ff"[BARFILE,($G(BARTMPF)="NOB") D  G RECAP

 .W !!,"A PATIENT or a BILL NUMBER is required!" H 1

 ;end new SDR

 I "Ff"[BARFILE,BARTMPF="NOK" D

 . W !!

 . S DIR("A",1)="Patient in Item 5 does not match Patient in Item 6"

 . S DIR("A",2)="Do you still want to file this data?"

 . S DIR("A",3)="   Enter 'YES' to File data"

 . S DIR("A",4)="   Enter 'NO' to Modify data"

 . S DIR("A",5)=" "

 . S DIR("A")= "Enter YES/NO:   "

 . S DIR("B")="NO"

 . S DIR(0)="YA"

 . D ^DIR

 . I Y=1 S BARTMPF="OK" Q

 I "Ff"[BARFILE,BARTMPF="OK" Q

 I "Ff"[BARFILE,BARTMPF="NOK" G RECAP

 I "Qq"[BARFILE,Y=1 S BARQUIT=1 Q

 I "Qq"[BARFILE,Y=0 G FMQ

 ;

 I "Qq"[BARFILE D

 . W !!

 . S DIR("A",1)="Are you sure you want to quit?"

 . S DIR("A",2)="The data you have entered will not be saved."

 . S DIR("A")="Proceed with quit?  YES/NO   "

 . S DIR("B")="NO"

 . S DIR(0)="YA"

 . D ^DIR

 I "Qq"[BARFILE,Y=1 S BARQUIT=1 Q   ;M819*ADD*TMM*20100826

 I "Qq"[BARFILE,Y=0 G FMQ

 S BARDONE=0

 F I=1:1 D  Q:BARDONE

 . S BARUPDT=1

 . D UPDT

 . S BARUPDT=0

 Q

 ;

FILE ;File prepayment

 ; Get new IEN for ^BARPPAY

 S BARPPIEN=$$NEW^BARPPY1A()

FDATA ;  Add Pre-Payment data

 K DIE,DR,DA

 ; Receipt #

 I '$D(BARPSAT(DUZ(2),2)) D BARPSAT^BARUTL0

 S BARSUFX=$G(BARPSAT(DUZ(2),2))

 S BARCPT=BARSUFX_$$PAD^BARPPY1A(BARPPIEN,10)

 S DR=".01////^S X=BARCPT"

 ; Other data

 D NOW^%DTC

 S BARPDOSE=$P(%,".")

 S DR=DR_";.02////^S X=BARPDOSE"      ;PAYMENT DATE

 S DR=DR_";.03////^S X=BARPMTYP"      ;PAYMENT TYPE 

 S DR=DR_";.04////^S X=$G(BARCK)"      ;CHECK #

 S DR=DR_";.05////^S X=$G(BARCNAME)"      ;BANK ACCOUNT OWNER NAME

 S DR=DR_";.06////^S X=$G(BARCTYPE)"      ;CARD TYPE

 S DR=DR_";.07////^S X=$G(BARAMT)"      ;CREDIT

 S DR=DR_";.08////^S X=$G(BARPTI1)"      ;PATIENT (IEN) (selected patient, not A/R BILL patient)

 S DR=DR_";.09////^S X=$G(BARBLIEN)"      ;A/R BILL

 S DR=DR_";.1////^S X=DUZ"      ;ENTERED BY

 S DR=DR_";.11////^S X=BARDEPTI"      ;DEPARTMENT

 S DR=DR_";.12////^S X=$G(BARDOSB)"      ;BILL DOS

 S DR=DR_";.13////^S X=BARPDOS"      ;PAYMENT FOR DOS

 S DR=DR_";.18////^S X=""N"""      ;BATCH FLAG

 ; Add to Pre-Payment file

 S DA=BARPPIEN

 S DIE=$$DIC^XBDIQ1(90050.06)

 D ^DIE

CMTFILE ;EP

 S BARIENS=BARPPIEN_","

 D WP^DIE(90050.06,BARIENS,101,"","BARCMT","MSG")

  D WP^DIE(90050.06,BARIENS,.2,"","BARCMT","MSG")

 W !!!,?9,"RECEIPT #:",?22,BARCPT

 Q

 ;

UPDT ;   Allow user to modify data entered

 Q:BARSTOP

 S (BARITEM,BARLIST)=""

 W !!

 D RESETDIR^BARPPY01

 S BARLIST="SAO^1:PAYMENT FOR DOS;2:CREDIT;3:DEPARTMENT"

 S BARLIST=BARLIST_";4:PAYMENT TYPE INFO"

 S BARLIST=BARLIST_";5:A/R BILL INFO"

 S BARLIST=BARLIST_";6:PATIENT"

 S BARLIST=BARLIST_";7:COMMENTS"

 S DIR(0)=BARLIST

 S DIR("A")="SELECT ITEM TO MODIFY: (?? for list) "

 K DA

 D ^DIR

 I $D(DIROUT) S BARSTOP=1 Q

 I $D(DTOUT)!$D(DUOUT) S BARDONE=1 Q

 K DIRUT

 S BARITEM=X

 I BARITEM=1 F I=1:1 D  Q:(+BARPDOS)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(BARSTOP)

 . ; Get DOS for this payment

 . S BARPDOS=""

 . D PAYDOS1^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=2 F I=1:1 D  Q:(+BARAMT>0)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(BARSTOP)

 . ; Enter Credit amount

 . D AMOUNT1^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=3 F I=1:1 D  Q:(BARDEPTI'="")!$D(DTOUT)!($D(DUOUT))!$D(DIROUT)!(BARSTOP)

 . D SELDEPT^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=4 F I=1:1 D  Q:($G(BARDAT))!$D(DTOUT)!($D(DUOUT))!$D(DIROUT)!(BARSTOP)

 . S BARDAT=0       ;required data collected flag

 . D SELPMT^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=5 F I=1:1 D  Q:($D(BARFPASS))!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(BARSTOP)

 . ; Get A/R Bill, Patient, A/R Bill DOS

 . K BARFPASS

 . D ARBILL1^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=6 F I=1:1 D  Q:($D(BARPTNM1))!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(BARSTOP)

 . ; Get Patient Name

 . D GETPAT1^BARPPY01

 . I $D(DIROUT) S BARSTOP=1

 I BARITEM=7 D CMTS^BARPPY01

 D RECAP

 S BARDONE=1

 Q

BARPPY1A  ; IHS/SD/TMM - PREPAYMENT ENTRY - CONT'D ; 05/11/2010

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/TMM 06/18/10 1.8*19 Add Prepayment functionality.

 +4       ; *********************************************************************

 +5       ;	

NEW()     ;EP - extrensic call to establish a new prepayment record

 +1       ; returns 0-lock on file, fm-dt/sec -IEN ; -1 not added

 +2        FOR I=1:1:5

               LOCK +^BARPPAY(DUZ(2)):2

               SET X=$TEST

               IF X

                   QUIT 

 +3        IF 'X

               Begin DoDot:1

 +4                WRITE *7,!!,"A/R PREPAYMENT FILE LOCKED, try again",!!

               End DoDot:1

               QUIT X

 +5       ;---- Create Pre-Payment record

 +6        KILL DIC,DR,DA

 +7        SET DIC="^BARPPAY(DUZ(2),"

 +8        SET DIC(0)="E"

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       KILL DR,DA,DIE

 +12       LOCK -^BARPPAY(DUZ(2))

 +13       QUIT +Y

 +14      ;

PAD(BARVAR,BARLNG) ; EP

 +1       ; BARVAR = data

 +2       ; BARLNG = length

 +3       ; Right justify, zero fill value BARVAR for length BARLNG

 +4        KILL BARZERO

 +5        SET $PIECE(BARZERO,"0",BARLNG+1)=""

 +6        SET BARVAR=BARZERO_BARVAR

 +7        SET BARVAR=$EXTRACT(BARVAR,$LENGTH(BARVAR)-(BARLNG-1),$LENGTH(BARVAR))

 +8        QUIT BARVAR

 +9       ;

CARDTYPE(CARD) ;  

 +1        SET CARDTYPE=$SELECT(CARD="A":"AMERICAN EXPRESS",CARD="C":"DINERS CLUB",CARD="D":"DISCOVER",CARD="M":"MASTERCARD",CARD="V":"VISA",1:"")

 +2        QUIT CARDTYPE

 +3       ;

PAYTYPE(PMTYP) ;

 +1        SET PAYTYPE=$SELECT(PMTYP="CA":"CASH",PMTYP="CK":"CHECK",PMTYP="CC":"CREDIT CARD",PMTYP="DB":"DEBIT CARD",1:"")

 +2        QUIT PAYTYPE

 +3       ;

CKOUT()   ;  Check DIR values

 +1        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$GET(BARSTOP)

               QUIT 1

 +2        QUIT 0

 +3       ;

 +4       ; *********************************************************************

HINPTON   ;   Hilight when PT NAME field

 +1        IF $GET(BARPAT)'=""

               IF BARPAT'=BARPTI1

                   Begin DoDot:1

 +2                    WRITE $$EN^BARVDF("HIN")

 +3                    SET HINPTON=1

                   End DoDot:1

 +4        QUIT 

 +5       ;

HINPTOFF  ;   Turn off Hilight when PT NAME field

 +1        WRITE $$EN^BARVDF("HIF")

 +2        SET HINPTON=0

 +3        QUIT 

 +4       ;

HINBLON   ;  Hilight DOS fields

 +1        IF BARDOSB'=""

               IF BARDOSB'=BARPDOS

                   Begin DoDot:1

 +2                    WRITE $$EN^BARVDF("HIN")

 +3                    SET HINBLON=1

                   End DoDot:1

 +4        QUIT 

 +5       ;

HINBLOFF  ;  Turn off hilight for DOS fields

 +1        WRITE "**",$$EN^BARVDF("HIF")

 +2        SET HINBLON=0

 +3        QUIT 

 +4       ;

RECAP     ;  Display data for user to review and select next step

 +1        IF BARSTOP

               QUIT 

 +2       ;Form Feed/Clear screen

           WRITE $$EN^BARVDF("IOF"),!

 +3       ;Clear screen

           WRITE $$EN^BARVDF("CLR")

 +4        SET Y=BARPDOS

 +5       ;get external date

           DO D^DIQ

 +6        DO HINBLON

 +7        WRITE !,"1)",?4,"PAYMENT FOR DOS:",?22,Y

 +8        IF HINBLON

               DO HINBLOFF

 +9        WRITE !,"2)",?4,"CREDIT: ",?22,"$",$FNUMBER(BARAMT,",",2)

 +10       WRITE !!,"3)",?4,"DEPARTMENT:",?22,BARDEPTE

 +11       IF BARPMTYP="CA"

               SET BARTMP="CASH^^"

 +12       IF BARPMTYP="CK"

               SET BARTMP="CHECK^CHECK NUMBER:^NAME ON CK ACCOUNT:"

 +13       IF BARPMTYP="CC"

               SET BARTMP="CREDIT CARD^CARD TYPE:^NAME ON CARD:"

 +14       IF BARPMTYP="DB"

               SET BARTMP="DEBIT CARD^CARD TYPE:^NAME ON CARD:"

 +15      ;PAYMENT TYPE line 1

           WRITE !!,"4)",?4,"PAYMENT TYPE:",?22,$PIECE(BARTMP,U)

 +16       SET BARTMP1=$SELECT(BARPMTYP="CK":BARCK,BARPMTYP="CC":BARCTYPN,BARPMTYP="DB":BARCTYPN,1:"")

 +17       IF $PIECE(BARTMP,U)'="CASH"

               Begin DoDot:1

 +18      ;PAYMENT TYPE line 2

                   WRITE !,?4,$PIECE(BARTMP,U,2),?22,BARTMP1

 +19               SET BARTMP1=$SELECT("^CK^CC^DB^"[BARPMTYP:BARCNAME,1:"")

 +20      ;PAYMENT TYPE line 3

                   WRITE !,?4,$PIECE(BARTMP,U,3),?22,BARTMP1

               End DoDot:1

 +21       WRITE !!,"5)",?4,"A/R BILL NUMBER:",?22,$$GET1^DIQ(90050.01,BARBLIEN_",",.01,"E")

 +22      ;hilight patient name when applicable

           IF BARBLIEN'=""

               DO HINPTON

 +23       WRITE !,?4,"PATIENT NAME:",?22,$SELECT(+BARPAT:$PIECE(^DPT(BARPAT,0),U),1:"")

 +24      ;hilight patient name when applicable

           IF HINPTON

               DO HINPTOFF

 +25       IF BARBLIEN'=""

               DO HINBLON

 +26       SET Y=$GET(BARDOSB)

 +27      ;converts internal FM date to external

           DO D^DIQ

 +28       WRITE !,?4,"BILL DOS:",?22,Y

 +29       IF HINBLON

               DO HINBLOFF

 +30       DO HINPTON

 +31       WRITE !!,"6)",?4,"PATIENT:",?22,BARPTNM1

 +32       IF HINPTON

               DO HINPTOFF

CMT       ;Comments

 +1       ; comments array

           KILL BARCMT

 +2        SET BARCMT=$LENGTH(BARCMTS)

 +3       ;SP-space; W- WordCtr; L-LINE#

           NEW SP,W,L,WORD

           SET SP=" "

           SET L=1

 +4        SET BARCMT(1)=""

 +5        FOR W=1:1

               SET WORD=$PIECE(BARCMTS,SP,W)

               IF WORD=""

                   QUIT 

               Begin DoDot:1

 +6       ; space betw words

                   IF W>1

                       SET WORD=SP_WORD

 +7                IF ($LENGTH(BARCMT(L))+$LENGTH(WORD))'>70

                       SET BARCMT(L)=BARCMT(L)_WORD

 +8       ; remove leading space

                  IF '$TEST

                       SET L=L+1

                       SET BARCMT(L)=$EXTRACT(WORD,2,99)

               End DoDot:1

 +9        IF BARCMT(1)=""

               KILL BARCMT

 +10       WRITE !!,"7)",?4,"COMMENTS:"

 +11       FOR I=1:1:4

               SET BARCMT=$ORDER(BARCMT(I))

               IF $GET(BARCMT(I))=""

                   QUIT 

               Begin DoDot:1

 +12               SET BARCMT(5)=BARCMT(I)

 +13               IF BARCMT(I)=1

                       WRITE "  "

 +14              IF '$TEST

                       IF $EXTRACT(BARCMT(5),$LENGTH(BARCMT(5)))'=" "&($EXTRACT(BARCMT(I))'=" ")

                           WRITE " "

 +15               WRITE BARCMT(I)

               End DoDot:1

 +16       KILL BARCMT(5)

 +17      ;

FMQ       ;  Prompt F/M/Q

 +1        IF $GET(BARDOSB)'=""

               IF BARDOSB'=BARPDOS

                   WRITE !!,?4,$$EN^BARVDF("HIN"),BARNOTE1,$$EN^BARVDF("HIF")

 +2        IF $GET(BARPAT)'=""

               IF BARPAT'=BARPTI1

                   WRITE $$EN^BARVDF("HIN"),!!,?4,BARNOTE2,$$EN^BARVDF("HIF")

 +3        SET BARFILE=""

 +4        WRITE !!

 +5        DO RESETDIR^BARPPY01

 +6        SET DIR(0)="SA^F:FILE;M:MODIFY;Q:QUIT"

 +7        SET DIR("A")="FILE PREPAYMENT?   SELECT (F)ILE, (M)ODIFY, (Q)UIT:  "

 +8        KILL DA

 +9        DO ^DIR

 +10       IF $DATA(DUOUT)!$DATA(DIROUT)

               GOTO FMQ

 +11       IF $DATA(DTOUT)

               QUIT 

 +12       SET BARFILE=X

 +13      ;

 +14      ; ---FILE---

 +15       IF "Ff"[BARFILE

               Begin DoDot:1

 +16      ;OK to file (No A/R Bill Selected, or A/R Bill selected and matches item 6 PATIENT)

                   SET BARTMPF="OK"

 +17      ;bar*1.8*19 SDR

                   IF +$GET(BARPTI1)=0

                       IF (+$GET(BARBLIEN)=0)

                           SET BARTMPF="NOB"

 +18      ;A/R Bill selected and does not match item 6 PATIENT)

                   IF $GET(BARPAT)'=""

                       IF BARPAT'=BARPTI1

                           SET BARTMPF="NOK"

               End DoDot:1

 +19      ;start new code bar*1.8*19 SDR

 +20       IF "Ff"[BARFILE

               IF ($GET(BARTMPF)="NOB")

                   Begin DoDot:1

 +21                   WRITE !!,"A PATIENT or a BILL NUMBER is required!"

                       HANG 1

                   End DoDot:1

                   GOTO RECAP

 +22      ;end new SDR

 +23       IF "Ff"[BARFILE

               IF BARTMPF="NOK"

                   Begin DoDot:1

 +24                   WRITE !!

 +25                   SET DIR("A",1)="Patient in Item 5 does not match Patient in Item 6"

 +26                   SET DIR("A",2)="Do you still want to file this data?"

 +27                   SET DIR("A",3)="   Enter 'YES' to File data"

 +28                   SET DIR("A",4)="   Enter 'NO' to Modify data"

 +29                   SET DIR("A",5)=" "

 +30                   SET DIR("A")=