Routine: BARPUTL

BARPUTL ; IHS/SD/LSL - POSTING UTILITIES ; 07/08/2010

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

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

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

SELBILL ; EP

 ; select bill

 ;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

 S DIC(0)="AEMQZ"

 ; IHS/SD/PKD 10/21/10

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

 D ^DIC

 Q:+Y<0

 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

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

 ; IHS/SD/PKD 1.8*19 10/21/10

DISP  ; New Tag Pt Lookup Display

 ; Naked reference - called from Fileman Display

 N DOS,STAT,CURRAMT

 Q:'$D(^(1))  ; No data,quit

 S DOS=$$SHDT^BARDUTL($P(^(1),U,2))

 S CURRAMT=$P(^(0),U,15)  ;I CURRAMT=0 S CURRAMT="0.00"

 ;Extra spaces after tabs on purpose.  keep fields apart.

 S STAT=$S($D(^BARTBL(+$P(^(0),U,16),0))#2:$P(^(0),U,1),1:"")

 W ?38," ",$J($FN(CURRAMT,"p",2),9),"  ",?48,STAT,?55," ",DOS,?63," ",$P(^BARBL(DUZ(2),Y,1),U,16)

GETBIL ;EP

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

 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

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

ASKPAT ;EP - select patient

 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

 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

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

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

ASKPATB(DICB) ;EP - select patient

 ; IHS/SD/TMM 1.8*19 7/6/10

 ; Copied from ASKPAT; allows user to pass default value for DIC("B"))

 K DIC,BARZ

 S DIC("B")=DICB

 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

 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

SELBILLB(DICB2) ; EP

 ; IHS/SD/TMM 1.8*19 7/11/10

 ; Copied from SELBILL: allows user to pass default value for DIC("B"))

 ; select bill

 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

 K DIC

 S DIC("B")=DICB2

 S DIC=90050.01

 S DIC(0)="AEMQZ"

 D ^DIC

 Q:+Y<0

 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

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

GETBILB(DICB3) ;EP

 ; IHS/SD/TMM 1.8*19 7/11/10

 ; Copied from GETBIL: allows user to pass default value for DIC("B"))

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

 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

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

BARPUTL   ; IHS/SD/LSL - POSTING UTILITIES ; 07/08/2010

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

 +2       ;

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

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

 +5        QUIT

 +6       ;

SELBILL   ; EP

 +1       ; select bill

 +2       ;IM24235 BAR*1.8*1

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

               Begin DoDot:1

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

 +5                KILL DIR

 +6                SET DIR(0)="E"

 +7                DO ^DIR

               End DoDot:1

               QUIT

 +8       ;END IM24235

 +9        KILL DIC

 +10       SET DIC=90050.01

 +11       SET DIC(0)="AEMQZ"

 +12      ; IHS/SD/PKD 10/21/10

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

 +14       DO ^DIC

 +15       IF +Y<0

               QUIT

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

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

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

 +19       IF BAREND=""

               SET BAREND=BARSTART

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

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

 +22       QUIT

 +23      ; *********************************************************************

 +24      ;

 +25      ; IHS/SD/PKD 1.8*19 10/21/10

DISP      ; New Tag Pt Lookup Display

 +1       ; Naked reference - called from Fileman Display

 +2        NEW DOS,STAT,CURRAMT

 +3       ; No data,quit

           IF '$DATA(^(1))

               QUIT

 +4        SET DOS=$$SHDT^BARDUTL($PIECE(^(1),U,2))

 +5       ;I CURRAMT=0 S CURRAMT="0.00"

           SET CURRAMT=$PIECE(^(0),U,15)

 +6       ;Extra spaces after tabs on purpose.  keep fields apart.

 +7        SET STAT=$SELECT($DATA(^BARTBL(+$PIECE(^(0),U,16),0))#2:$PIECE(^(0),U,1),1:"")

 +8        WRITE ?38," ",$JUSTIFY($FNUMBER(CURRAMT,"p",2),9),"  ",?48,STAT,?55," ",DOS,?63," ",$PIECE(^BARBL(DUZ(2),Y,1),U,16)

 +9        QUIT

GETBIL    ;EP

 +1        WRITE !

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

 +3        SET DIC(0)="AEQZ"

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

 +5        SET D="E"

 +6        DO IX^DIC

 +7        KILL DIC

 +8        IF +Y<0

               QUIT

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

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

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

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

 +13       WRITE "  ",BARPAT(0)

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

 +15       QUIT

 +16      ; *********************************************************************

 +17      ;

ASKPAT    ;EP - select patient

 +1        KILL DIC,BARZ

 +2        SET DIC="^AUPNPAT("

 +3        SET DIC(0)="IAEMQZ"

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

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

 +6        DO ^DIC

 +7        KILL DIC

 +8        IF +Y<0

               QUIT

 +9        SET BARPAT=+Y

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

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

 +12       DO GETDOS

 +13       IF '$GET(BAROK)

               KILL BARPAT

               QUIT

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

 +15       QUIT

 +16      ; *********************************************************************

 +17      ;

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

 +15      ;

ASKPATB(DICB) ;EP - select patient

 +1       ; IHS/SD/TMM 1.8*19 7/6/10

 +2       ; Copied from ASKPAT; allows user to pass default value for DIC("B"))

 +3        KILL DIC,BARZ

 +4        SET DIC("B")=DICB

 +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       SET BARPAT=+Y

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

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

 +15       DO GETDOS

 +16       IF '$GET(BAROK)

               KILL BARPAT

               QUIT

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

 +18       QUIT

 +19      ;

SELBILLB(DICB2) ; EP

 +1       ; IHS/SD/TMM 1.8*19 7/11/10

 +2       ; Copied from SELBILL: allows user to pass default value for DIC("B"))

 +3       ; select bill

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

               Begin DoDot:1

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

 +6                KILL DIR

 +7                SET DIR(0)="E"

 +8                DO ^DIR

               End DoDot:1

               QUIT

 +9        KILL DIC

 +10       SET DIC("B")=DICB2

 +11       SET DIC=90050.01

 +12       SET DIC(0)="AEMQZ"

 +13       DO ^DIC

 +14       IF +Y<0

               QUIT

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

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

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

 +18       IF BAREND=""

               SET BAREND=BARSTART

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

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

 +21       QUIT

 +22      ; *********************************************************************

 +23      ;

GETBILB(DICB3) ;EP

 +1       ; IHS/SD/TMM 1.8*19 7/11/10

 +2       ; Copied from GETBIL: allows user to pass default value for DIC("B"))

 +3        WRITE !

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

 +5        SET DIC(0)="AEQZ"

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

 +7        SET D="E"

 +8        DO IX^DIC

 +9        KILL DIC

 +10       IF +Y<0

               QUIT

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

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

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

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

 +15       WRITE "  ",BARPAT(0)

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

 +17       QUIT

 +18      ; **************************

BARPUTL.m