BARBAD1.m

BARBAD1 ; IHS/SD/LSL - Posting and Adjustments ;

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

 ;

EN() ; EP

 ; Batch Posting entry

 K BARPAT,BARZ

 D SELBILL

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT) 0

 I $G(BARZ) Q BARZ

 D ASKPAT

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT) 0

 I $G(BARZ) Q BARZ

 D GETBIL

 I $G(BARZ) Q BARZ

 Q 0

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

 ;

TOP(BARV) ; EP

 ; Select Batch 

 W !!!

 W "Select Batch: "_$P(BARCOL(0),U,1)

 S Y=+BARCOL

 D BATW^BARBAD

 D BBAL^BARBAD(BARCOL)

 W !!,"Select Item: "_BARITM

 S Y=+BARITM

 D DICW^BARBAD

 D IBAL^BARBAD(BARITM)

 I $G(BAREOB) D

 .N DA

 .W !!

 .W "Select Visit Location: "

 .S DA=BAREOB

 .S DA(1)=+BARITM

 .S DA(2)=+BARCOL

 .W $$VAL^XBDIQ1(90051.1101601,.DA,.01)

 .D EBAL^BARBAD(BAREOB)

 Q:'BARV

 W !!

 W "Select Patient: "_$P(BARPAT(0),U,1)

 Q

SELBILL ; EP

 ; select bill

 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN

 ;IM24235 BAR*1.8*1

 I '$D(^BARBL(DUZ(2))) D  Q

 .W !!,$P(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"

 .K DIR

 .S DIR(0)="E"

 .D ^DIR

 ;END IM24235

 K DIC

 S DIC=90050.01

 ; IHS/SD/PKD 10/22/10 Selection Display-more info

 S DIC("W")="D DISP^BARPUTL"

 S DIC(0)="AEMQZ"

 D ^DIC

 Q:+Y<0

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")

 S BARPAT=$P(^BARBL(DUZ(2),+Y,1),"^",1)

 S BARSTART=$P(^BARBL(DUZ(2),+Y,1),"^",2)

 S BAREND=$P(^BARBL(DUZ(2),+Y,1),"^",3)

 S:BAREND="" BAREND=BARSTART

 S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",1)

 S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 Q

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

 ;

GETBIL ;EP

 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN

 ;

 W !

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

 S DIC(0)="AEQZ"

 S DIC("A")="Select Bill DOS: "

 S D="E"

 D IX^DIC

 K DIC

 Q:+Y<0

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")

 S BARPAT=$P(^BARBL(DUZ(2),+Y,1),"^",1)

 S BARSTART=$P(^BARBL(DUZ(2),+Y,1),"^",2)

 S BAREND=$P(^BARBL(DUZ(2),+Y,1),"^",3)

 S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",2)

 W "  ",BARPAT(0)

 S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 Q

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

 ;

ASKPAT ;EP - select patient

 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q  ;IS SESSION STILL OPEN

 ;

 K DIC,BARZ

 S DIC="^AUPNPAT("

 S DIC(0)="IAEMQZ"

 S DIC("S")="Select Patient: "

 S DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"

 D ^DIC

 K DIC

 Q:+Y<0

 Q:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)!(Y="")!(Y=" ")

 S BARPAT=+Y

 S BARPAT(0)=Y(0)

 S BARPAT(0)=$P($G(^DPT(+BARPAT,0)),"^",1)

 D GETDOS

 I '$G(BAROK) K BARPAT Q

 S BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 Q

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

 ;

GETDOS ; EP

 ; dates of service

 K BARSTART,BAREND,BAROK

 W !

 S BARSTART=$$DATE^BARDUTL(1)

 Q:BARSTART<0

 S %DT("B")=$$MDT2^BARDUTL(BARSTART)

 S BAREND=$$DATE^BARDUTL(2)

 Q:BAREND<0

 I BAREND<BARSTART D  G GETDOS

 .W *7

 .D EOP^BARUTL(2)

 .W !,"The END date must not be before the START date.",!

 S BAROK=1

 Q

BARBAD1   ; IHS/SD/LSL - Posting and Adjustments ;

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

 +2       ;

EN()      ; EP

 +1       ; Batch Posting entry

 +2        KILL BARPAT,BARZ

 +3        DO SELBILL

 +4        IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)

               QUIT 0

 +5        IF $GET(BARZ)

               QUIT BARZ

 +6        DO ASKPAT

 +7        IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)

               QUIT 0

 +8        IF $GET(BARZ)

               QUIT BARZ

 +9        DO GETBIL

 +10       IF $GET(BARZ)

               QUIT BARZ

 +11       QUIT 0

 +12      ; *********************************************************************

 +13      ;

TOP(BARV) ; EP

 +1       ; Select Batch 

 +2        WRITE !!!

 +3        WRITE "Select Batch: "_$PIECE(BARCOL(0),U,1)

 +4        SET Y=+BARCOL

 +5        DO BATW^BARBAD

 +6        DO BBAL^BARBAD(BARCOL)

 +7        WRITE !!,"Select Item: "_BARITM

 +8        SET Y=+BARITM

 +9        DO DICW^BARBAD

 +10       DO IBAL^BARBAD(BARITM)

 +11       IF $GET(BAREOB)

               Begin DoDot:1

 +12               NEW DA

 +13               WRITE !!

 +14               WRITE "Select Visit Location: "

 +15               SET DA=BAREOB

 +16               SET DA(1)=+BARITM

 +17               SET DA(2)=+BARCOL

 +18               WRITE $$VAL^XBDIQ1(90051.1101601,.DA,.01)

 +19               DO EBAL^BARBAD(BAREOB)

               End DoDot:1

 +20       IF 'BARV

               QUIT 

 +21       WRITE !!

 +22       WRITE "Select Patient: "_$PIECE(BARPAT(0),U,1)

 +23       QUIT 

SELBILL   ; EP

 +1       ; select bill

 +2       ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 +3       ;IS SESSION STILL OPEN

           IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))

               QUIT 

 +4       ;IM24235 BAR*1.8*1

 +5        IF '$DATA(^BARBL(DUZ(2)))

               Begin DoDot:1

 +6                WRITE !!,$PIECE(^DIC(4,DUZ(2),0),U)," DOES NOT HAVE ANY BILLS TO LIST!"

 +7                KILL DIR

 +8                SET DIR(0)="E"

 +9                DO ^DIR

               End DoDot:1

               QUIT 

 +10      ;END IM24235

 +11       KILL DIC

 +12       SET DIC=90050.01

 +13      ; IHS/SD/PKD 10/22/10 Selection Display-more info

 +14       SET DIC("W")="D DISP^BARPUTL"

 +15       SET DIC(0)="AEMQZ"

 +16       DO ^DIC

 +17       IF +Y<0

               QUIT 

 +18       IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")

               QUIT 

 +19       SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)

 +20       SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)

 +21       SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)

 +22       IF BAREND=""

               SET BAREND=BARSTART

 +23       SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)

 +24       SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 +25       QUIT 

 +26      ; *********************************************************************

 +27      ;

GETBIL    ;EP

 +1       ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 +2       ;IS SESSION STILL OPEN

           IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))

               QUIT 

 +3       ;

 +4        WRITE !

 +5        SET DIC="^BARBL(DUZ(2),"

 +6        SET DIC(0)="AEQZ"

 +7        SET DIC("A")="Select Bill DOS: "

 +8        SET D="E"

 +9        DO IX^DIC

 +10       KILL DIC

 +11       IF +Y<0

               QUIT 

 +12       IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")

               QUIT 

 +13       SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y,1),"^",1)

 +14       SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y,1),"^",2)

 +15       SET BAREND=$PIECE(^BARBL(DUZ(2),+Y,1),"^",3)

 +16       SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",2)

 +17       WRITE "  ",BARPAT(0)

 +18       SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 +19       QUIT 

 +20      ; *********************************************************************

 +21      ;

ASKPAT    ;EP - select patient

 +1       ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490

 +2       ;IS SESSION STILL OPEN

           IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))

               QUIT 

 +3       ;

 +4        KILL DIC,BARZ

 +5        SET DIC="^AUPNPAT("

 +6        SET DIC(0)="IAEMQZ"

 +7        SET DIC("S")="Select Patient: "

 +8        SET DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"

 +9        DO ^DIC

 +10       KILL DIC

 +11       IF +Y<0

               QUIT 

 +12       IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)!(Y="")!(Y=" ")

               QUIT 

 +13       SET BARPAT=+Y

 +14       SET BARPAT(0)=Y(0)

 +15       SET BARPAT(0)=$PIECE($GET(^DPT(+BARPAT,0)),"^",1)

 +16       DO GETDOS

 +17       IF '$GET(BAROK)

               KILL BARPAT

               QUIT 

 +18       SET BARZ=BARPAT_"^"_BARSTART_"^"_BAREND

 +19       QUIT 

 +20      ; *********************************************************************

 +21      ;

GETDOS    ; EP

 +1       ; dates of service

 +2        KILL BARSTART,BAREND,BAROK

 +3        WRITE !

 +4        SET BARSTART=$$DATE^BARDUTL(1)

 +5        IF BARSTART<0

               QUIT 

 +6        SET %DT("B")=$$MDT2^BARDUTL(BARSTART)

 +7        SET BAREND=$$DATE^BARDUTL(2)

 +8        IF BAREND<0

               QUIT 

 +9        IF BAREND<BARSTART

               Begin DoDot:1

 +10               WRITE *7

 +11               DO EOP^BARUTL(2)

 +12               WRITE !,"The END date must not be before the START date.",!

               End DoDot:1

               GOTO GETDOS

 +13       SET BAROK=1

 +14       QUIT