BARDINQ.m

BARDINQ ; IHS/SD/LSL - A/R Debt Collection Bill Inquire ;08/20/2008

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

 ;

 ; IHS/SD/LSL - 04/28/2004 - V1.8

 ;      Routine created.

 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

 Q

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

 ;

EP ; EP

 K BARY,BAR

 D:'$D(BARUSR) INIT^BARUTL           ; Set up basic A/R Variables

 D SELBILL                        ; Select bill by #, pat, dos

 Q:'$D(BARBIEN)                   ; Bill not selected

 S BARPAT=$$GET1^DIQ(90050.01,BARBIEN,101)

 D DATES^BARDLOG                  ; Ask date range

 I +BARSTART<1  Q                   ;No dates entered

 S BARQ("RC")="PROCESS^BARDINQ"     ; Build tmp global with data

 S BARQ("RP")="PRINT^BARDINQ"       ; Print reports from tmp global

 S BARQ("NS")="BAR"                 ; Namespace for variables

 S BARQ("RX")="POUT^BARRUTL"        ; Clean-up routine

 D ^BARDBQUE                        ; Double queuing

 ;D PAZ^BARRUTL                      ; Press return to continue

 Q

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

 ;

SELBILL ;

 W !!

 K DIC,DR,X,Y,DA

 S DIC=90050.01

 S DIC(0)="AEMQZ"

 K DD,DO

 D ^DIC

 I $D(DUOUT)!($D(DTOUT)) Q

 I +Y<0 D  Q

 . D PAT

 . K BARTMP,BARPAT,BARDOS,BARBL,BARCNT

 S BARBIEN=+Y

 Q

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

 ;

PAT ;

 ; If don't know bill, ask patient

 N BARBL,BARCNT

 K DIC,DA,DR,X,Y

 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 BARDOS=0,BARCNT=0

 F  S BARDOS=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS)) Q:'+BARDOS  D

 . S BARBL=0

 . F  S BARBL=$O(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS,BARBL)) Q:'+BARBL  D

 . . Q:'$D(^BARBL(DUZ(2),BARBL,0))

 . . S BARCNT=BARCNT+1

 . . S BARTMP(BARCNT)=$$GET1^DIQ(90050.01,BARBL,.01)_U_$$SDT^BARDUTL(BARDOS)_U_BARBL

 ;

 W !

 S BARCNT=0

 F  S BARCNT=$O(BARTMP(BARCNT)) Q:'+BARCNT  D

 . W !,$J(BARCNT,2),".",?5,$P(BARTMP(BARCNT),U),?40,$P(BARTMP(BARCNT),U,2)

 ;

 S BARANS=0

 W !

 K DIR

 S DIR(0)="NAO^1:"_BARCNT

 S DIR("A")="Please enter the LINE # of the bill chosen for Inquiry: "

 S DIR("?")="Enter a number between 1 and "_BARCNT

 D ^DIR

 Q:'+Y

 S BARBIEN=$P(BARTMP(+Y),U,3)

 Q

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

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

 ;

PROCESS ; EP

 K ^TMP($J,"BAR-DLOG")

 Q:'$D(^BARDEBT("C",BARBIEN))      ; Bill not in log.

 S BARIEN=0

 F  S BARIEN=$O(^BARDEBT("C",BARBIEN,BARIEN)) Q:'+BARIEN  D DATA

 Q

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

 ;

DATA ;

 Q:'$D(^BARDEBT(BARIEN,0))        ; No data

 Q:DUZ(2)'=$P($G(^BARDEBT(BARIEN,0)),U,8)      ; Bill not this DUZ(2)

 S BARDATE=$P($G(^BARDEBT(BARIEN,0)),U)        ; date sent

 Q:BARDATE<BARSTART

 Q:BARDATE>BAREND

 D DATA^BARDLOG                   ; Set temp global

 Q

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

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

 ;

PRINT ; EP

 K BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD

 S BARHDR="DEBT COLLECTION BILL INQUIRY REPORT"

 S BARPG=0

 D NOW^%DTC

 S Y=%

 X ^DD("DD")

 S BARUN=$P(Y,":",1,2)

 S $P(BARDASH,"-",81)=""

 D HEADP^BARDLOG

 ;

 ; No data

 I '$D(^TMP($J,"BAR-DLOG")) D  Q

 . W !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)

 . D PAZ^BARRUTL

 ;

 W !?5,"Patient Name: ",$G(BARPAT)

 S (BARTOT,BARCNT,BARSTOP)=0

 S BARTOT2=0

 S BARAC=""

 F  S BARAC=$O(^TMP($J,"BAR-DLOG",BARAC)) Q:BARAC=""  D ACCTP^BARDLOG Q:BARSTOP

 Q:BARSTOP

 W !?42,"----------",?69,"----------"

 W !?42,$J(BARTOT,10,2)," (",BARCNT,")",?69,$J(BARTOT2,10,2)

 D PAZ^BARRUTL

 Q

BARDINQ   ; IHS/SD/LSL - A/R Debt Collection Bill Inquire ;08/20/2008

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

 +2       ;

 +3       ; IHS/SD/LSL - 04/28/2004 - V1.8

 +4       ;      Routine created.

 +5       ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

 +6        QUIT 

 +7       ; ********************************************************************

 +8       ;

EP        ; EP

 +1        KILL BARY,BAR

 +2       ; Set up basic A/R Variables

           IF '$DATA(BARUSR)

               DO INIT^BARUTL

 +3       ; Select bill by #, pat, dos

           DO SELBILL

 +4       ; Bill not selected

           IF '$DATA(BARBIEN)

               QUIT 

 +5        SET BARPAT=$$GET1^DIQ(90050.01,BARBIEN,101)

 +6       ; Ask date range

           DO DATES^BARDLOG

 +7       ;No dates entered

           IF +BARSTART<1

               QUIT 

 +8       ; Build tmp global with data

           SET BARQ("RC")="PROCESS^BARDINQ"

 +9       ; Print reports from tmp global

           SET BARQ("RP")="PRINT^BARDINQ"

 +10      ; Namespace for variables

           SET BARQ("NS")="BAR"

 +11      ; Clean-up routine

           SET BARQ("RX")="POUT^BARRUTL"

 +12      ; Double queuing

           DO ^BARDBQUE

 +13      ;D PAZ^BARRUTL                      ; Press return to continue

 +14       QUIT 

 +15      ; ********************************************************************

 +16      ;

SELBILL   ;

 +1        WRITE !!

 +2        KILL DIC,DR,X,Y,DA

 +3        SET DIC=90050.01

 +4        SET DIC(0)="AEMQZ"

 +5        KILL DD,DO

 +6        DO ^DIC

 +7        IF $DATA">DATA(DUOUT)!($DATA">DATA(DTOUT))

               QUIT 

 +8        IF +Y<0

               Begin DoDot:1

 +9                DO PAT

 +10               KILL BARTMP,BARPAT,BARDOS,BARBL,BARCNT

               End DoDot:1

               QUIT 

 +11       SET BARBIEN=+Y

 +12       QUIT 

 +13      ; ********************************************************************

 +14      ;

PAT       ;

 +1       ; If don't know bill, ask patient

 +2        NEW BARBL,BARCNT

 +3        KILL DIC,DA,DR,X,Y

 +4        SET DIC="^AUPNPAT("

 +5        SET DIC(0)="IAEMQZ"

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

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

 +8        DO ^DIC

 +9        KILL DIC

 +10       IF +Y<0

               QUIT 

 +11       SET BARPAT=+Y

 +12      ;

 +13       SET BARDOS=0

           SET BARCNT=0

 +14       FOR 

               SET BARDOS=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS))

               IF '+BARDOS

                   QUIT 

               Begin DoDot:1

 +15               SET BARBL=0

 +16               FOR 

                       SET BARBL=$ORDER(^BARBL(DUZ(2),"ABC",BARPAT,BARDOS,BARBL))

                       IF '+BARBL

                           QUIT 

                       Begin DoDot:2

 +17                       IF '$DATA(^BARBL(DUZ(2),BARBL,0))

                               QUIT 

 +18                       SET BARCNT=BARCNT+1

 +19                       SET BARTMP(BARCNT)=$$GET1^DIQ(90050.01,BARBL,.01)_U_$$SDT^BARDUTL(BARDOS)_U_BARBL

                       End DoDot:2

               End DoDot:1

 +20      ;

 +21       WRITE !

 +22       SET BARCNT=0

 +23       FOR 

               SET BARCNT=$ORDER(BARTMP(BARCNT))

               IF '+BARCNT

                   QUIT 

               Begin DoDot:1

 +24               WRITE !,$JUSTIFY(BARCNT,2),".",?5,$PIECE(BARTMP(BARCNT),U),?40,$PIECE(BARTMP(BARCNT),U,2)

               End DoDot:1

 +25      ;

 +26       SET BARANS=0

 +27       WRITE !

 +28       KILL DIR

 +29       SET DIR(0)="NAO^1:"_BARCNT

 +30       SET DIR("A")="Please enter the LINE # of the bill chosen for Inquiry: "

 +31       SET DIR("?")="Enter a number between 1 and "_BARCNT

 +32       DO ^DIR

 +33       IF '+Y

               QUIT 

 +34       SET BARBIEN=$PIECE(BARTMP(+Y),U,3)

 +35       QUIT 

 +36      ; ********************************************************************

 +37      ; ********************************************************************

 +38      ;

PROCESS   ; EP

 +1        KILL ^TMP($JOB,"BAR-DLOG")

 +2       ; Bill not in log.

           IF '$DATA(^BARDEBT("C",BARBIEN))

               QUIT 

 +3        SET BARIEN=0

 +4        FOR 

               SET BARIEN=$ORDER(^BARDEBT("C",BARBIEN,BARIEN))

               IF '+BARIEN

                   QUIT 

               DO DATA

 +5        QUIT 

 +6       ; ********************************************************************

 +7       ;

DATA      ;

 +1       ; No data

           IF '$DATA(^BARDEBT(BARIEN,0))

               QUIT 

 +2       ; Bill not this DUZ(2)

           IF DUZ(2)'=$PIECE($GET(^BARDEBT(BARIEN,0)),U,8)

               QUIT 

 +3       ; date sent

           SET BARDATE=$PIECE($GET(^BARDEBT(BARIEN,0)),U)

 +4        IF BARDATE<BARSTART

               QUIT 

 +5        IF BARDATE>BAREND

               QUIT 

 +6       ; Set temp global

           DO DATA^BARDLOG

 +7        QUIT 

 +8       ; ********************************************************************

 +9       ; ********************************************************************

 +10      ;

PRINT     ; EP

 +1        KILL BARAC,BARDOS,BARIEN,BARBL,BARDATE,BARBAL,BARACT,BARHOLD

 +2        SET BARHDR="DEBT COLLECTION BILL INQUIRY REPORT"

 +3        SET BARPG=0

 +4        DO NOW^%DTC

 +5        SET Y=%

 +6        XECUTE ^DD("DD")

 +7        SET BARUN=$PIECE(Y,":",1,2)

 +8        SET $PIECE(BARDASH,"-",81)=""

 +9        DO HEADP^BARDLOG

 +10      ;

 +11      ; No data

 +12       IF '$DATA(^TMP($JOB,"BAR-DLOG"))

               Begin DoDot:1

 +13               WRITE !!,$$CJ^XLFSTR("******* NO RECORDS TO PRINT *******",IOM)

 +14               DO PAZ^BARRUTL

               End DoDot:1

               QUIT 

 +15      ;

 +16       WRITE !?5,"Patient Name: ",$GET(BARPAT)

 +17       SET (BARTOT,BARCNT,BARSTOP)=0

 +18       SET BARTOT2=0

 +19       SET BARAC=""

 +20       FOR 

               SET BARAC=$ORDER(^TMP($JOB,"BAR-DLOG",BARAC))

               IF BARAC=""

                   QUIT 

               DO ACCTP^BARDLOG

               IF BARSTOP

                   QUIT 

 +21       IF BARSTOP

               QUIT 

 +22       WRITE !?42,"----------",?69,"----------"

 +23       WRITE !?42,$JUSTIFY(BARTOT,10,2)," (",BARCNT,")",?69,$JUSTIFY(BARTOT2,10,2)

 +24       DO PAZ^BARRUTL

 +25       QUIT