BARUFRP3 ; IHS/SD/TPF - UFMS REPORTS SECONDARY CALLS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**6,13,20,22,23**;OCT 26, 2005;Build 38
; FEB 2013 P.OTT CHANGED PTR TO INSURER TYPE
Q
GRNTOT ;EP;
K PAGE
D NOW^%DTC S Y=% X ^DD("DD") S DATE=Y
S Y=START X ^DD("DD") S EXSTART=Y
S Y=END X ^DD("DD") S EXEND=Y
S ESC=0
S RPTTYP="G"
D BATHDR^BARUFRPT(DATE,RPTTYP)
S:END'[(".") END=END_".999999"
D SUMINIT^BARUFRPT
W !,"TRANSMISSIONS:"
S BATCH=START-.000001
F S BATCH=$O(^BARSESS(DUZ(2),"F",BATCH)) Q:'BATCH!(ESC)!(BATCH>END) D
.W !?2,$$TDT^BARDUTL(BATCH)
.S UDUZ=""
.F S UDUZ=$O(^BARSESS(DUZ(2),"F",BATCH,UDUZ)) Q:'UDUZ!(ESC) D
..S SESSID=""
..F S SESSID=$O(^BARSESS(DUZ(2),"F",BATCH,UDUZ,SESSID)) Q:'SESSID!(ESC) D
...S TRDATE=0
...F S TRDATE=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE)) Q:'TRDATE!(ESC) D
.... ;IHS/SD/PKD 11/30/10 1.8*20 HEAT P/U TRX ONLY IF IN EXPORT DATE RANGE
.... N TRQUIT S TRQUIT=^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)
.... Q:$P(TRQUIT,U,2)'=1 ; Not Transmitted
.... S TRQUIT=$P(TRQUIT,U,4) ; Date this TRX went to UFMS
.... Q:TRQUIT<(START-.000001)!(TRQUIT>END)
.... ; END 1.8*20
....S IENS=TRDATE_","
....D GETDATA
....Q:'BILL
....I $Y>(IOSL-4) W ! D:$D(IO("S")) BATHDR^BARUFRPT(DATE,RPTTYP) Q:$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)) ^DIR S ESC=X=U Q:ESC D BATHDR^BARUFRPT(DATE,RPTTYP)
....D COUNT^BARUFRPT(.TOTALS)
;start old code bar*1.8*22 HEAT51432 (IHS/SD/NKD) DS were doubling on GTOT
;S TRDATE=0
;F S TRDATE=$O(^BARSESS(DUZ(2),"DS",TRDATE)) Q:'TRDATE!(ESC)!(TRDATE>END) D
;.S SESSID=""
;.F S SESSID=$O(^BARSESS(DUZ(2),"DS",TRDATE,SESSID)) Q:'SESSID!(ESC) D
;..S UDUZ=""
;..F S UDUZ=$O(^BARSESS(DUZ(2),"DS",TRDATE,SESSID,UDUZ)) Q:'UDUZ!(ESC) D
;...I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)="" Q
;...I '$D(BARFLST($P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8))) Q
;...S IENS=TRDATE_","
;...D GETDATA
;...Q:'BILL
;...I $Y>(IOSL-4) W ! D:$D(IO("S")) BATHDR^BARUFRPT(DATE,RPTTYP) Q:$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)) ^DIR S ESC=X=U Q:ESC D BATHDR^BARUFRPT(DATE,RPTTYP)
;...D COUNT^BARUFRPT(.TOTALS)
;end old code HEAT51432
W !,DASH,!,?10,"SESSION TOTALS",?30,"DS TOTALS",?46,"NS TOTALS",?63,"TRANS. TOTALS",!,DASH
D LIST^BARUFRPT(.TOTALS)
I $D(IO("S")) W @IOF ;flush buffer
Q
;
GETDATA ;
S CREDIT=$$GET1^DIQ(90050.03,IENS,2)
S DEBIT=$$GET1^DIQ(90050.03,IENS,3)
S (CREDDEBT,AMT)=$$GET1^DIQ(90050.03,IENS,3.5,"E")
S BILL=$$GET1^DIQ(90050.03,IENS,4)
Q:'BILL
S BLLIEN=$$GET1^DIQ(90050.03,IENS,4,"I")
S ENTRYBY=$$GET1^DIQ(90050.03,IENS,13,"E")
S TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
S TRANTYP=$$GET1^DIQ(90050.03,IENS,101,"E")
S ADJCAT=$$GET1^DIQ(90050.03,IENS,102,"E")
S BARIIEN=$$INSIEN^BARUTL("BILL",BLLIEN,DUZ(2))
I BARIIEN'="" D
. S BARALLC=$$GET1^DIQ(9999999.18,BARIIEN,.211,"I") ;RETURNS NUM PTR (I.E. 21) P.OTT GET INS TYP
. ;W !,"ABARALLC(1)=",BARALLC ;P.OTT
. S BARALLC=$P($G(^AUTTINTY(BARALLC,0)),U,2) ;NUMBER-->"INDIAN PATIENT^I"
. ;W !,"ABARALLC(2)=",BARALLC
. S BARALLC=$P($T(@BARALLC^BARRNEGB),";;",2) ;ALL CAT
. ;W " ABARALLC(3)=",BARALLC
I $G(BARALLC)="" S BARALLC="OTHER" ;default, just in case ;IHS/SD/TPF BAR*1.8*13 4/21/2009
;W " ABARALLC(FINAL)=",BARALLC R ASD
Q
SETVAR ;EP;
S (ADJACNT,ADJAAMT,REFACNT,REFAAMT)=0
S (BARAPCNT,BARAPAMT)=0
S (BARRCCNT,BARRCAMT)=0
S (BARNPCNT,BARNPAMT,BARTPCNT,BARTPAMT)=0
S (REFTCNT,REFTAMT,REFNCNT,REFNAMT)=0
S (ADJTCNT,ADJTAMT,ADJNCNT,ADJNAMT)=0
S (BARCACNT,BARCAAMT,BARCNCNT,BARCNAMT,BARCTCNT,BARCTAMT)=0
S (BARDPCNT,BARDPAMT,BARDACNT,BARDAAMT,BARDRCNT,BARDRAMT,BARDCCNT,BARDCAMT)=0
S (BARZPCNT,BARZPAMT,BARZDCNT,BARZDAMT,BARZNCNT,BARZNAMT)=0
S (BARZACNT,BARZAAMT,BARZDCNT,BARZDAMT,BARZNAMT)=0
Q
TOT ;EP;
I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)="" D
.S TOTALS(CAT,BARALLC,"ALL")=$G(TOTALS(CAT,BARALLC,"ALL"))+AMT
.S TOTALS(CAT,BARALLC,"ALL","CNT")=$G(TOTALS(CAT,BARALLC,"ALL","CNT"))+1
I CAT="AAZERO" D
.S TOTALS(CAT,BARALLC,"ZP")=$G(TOTALS(CAT,BARALLC,"ZP"))+AMT
.S TOTALS(CAT,BARALLC,"ZP","CNT")=$G(TOTALS(CAT,BARALLC,"ZP","CNT"))+1
I CAT="ADJZERO" D
.S TOTALS(CAT,BARALLC,"ZA")=$G(TOTALS(CAT,BARALLC,"ZA"))+AMT
.S TOTALS(CAT,BARALLC,"ZA","CNT")=$G(TOTALS(CAT,BARALLC,"ZA","CNT"))+1
I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)'="" D
.S TOTALS(CAT,BARALLC,"DS","CNT")=$G(TOTALS(CAT,BARALLC,"DS","CNT"))+1
.S TOTALS(CAT,BARALLC,"DS")=$G(TOTALS(CAT,BARALLC,"DS"))+AMT
I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,6)=1!(TRANTYP="REMARK CODE") D
.S TOTALS(CAT,BARALLC,"NS","CNT")=$G(TOTALS(CAT,BARALLC,"NS","CNT"))+1
.S TOTALS(CAT,BARALLC,"NS")=$G(TOTALS(CAT,BARALLC,"NS"))+AMT
I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,6)'=1,((TRANTYP'="REMARK CODE")!(CAT'="ZERO")) D
.S TOTALS(CAT,BARALLC,"TR","CNT")=$G(TOTALS(CAT,BARALLC,"TR","CNT"))+1
.S TOTALS(CAT,BARALLC,"TR")=$G(TOTALS(CAT,BARALLC,"TR"))+AMT
Q
WRITEDET ;EP;
W !?2,$S(BARALLC["VETERAN":"VET",BARALLC["PRIVATE":"PVT",BARALLC["MEDICARE":"MCR",BARALLC["MEDICAID":"MCD",1:"OTH") ;P.OTT
W ?7,$J(TOTALS(CATEGORY,BARALLC,"ALL","CNT"),6)
W ?14,"$"_$J(TOTALS(CATEGORY,BARALLC,"ALL"),10,2)
W ?27,$J(TOTALS(CATEGORY,BARALLC,"DS","CNT"),4)
W ?32,"$"_$J(TOTALS(CATEGORY,BARALLC,"DS"),8,2)
W ?43,$J($S(CATEGORY="AAZERO":BARZPCNT,CATEGORY="ADJZERO":BARZACNT,1:TOTALS(CATEGORY,BARALLC,"NS","CNT")),4)
W ?48,"$"_$J($S(CATEGORY="AAZERO":BARZPAMT,CATEGORY="ADJZERO":BARZAAMT,1:TOTALS(CATEGORY,BARALLC,"NS")),8,2)
W ?59,$J(TOTALS(CATEGORY,BARALLC,"TR","CNT"),6)
W ?66,"$"_$J(TOTALS(CATEGORY,BARALLC,"TR"),10,2)
Q
WRITETOT ;EP;
W !,?7,"------------------"
W ?27,"--------------"
W ?43,"--------------"
W ?59,"------------------"
W !?2,"TOTAL"
I $P(CATEGORY," ")="AAA" D
.W ?7,$J(BARAPCNT,6)
.W ?14,"$"_$J(BARAPAMT,10,2)
.W ?27,$J(BARDPCNT,4)
.W ?32,"$"_$J(BARDPAMT,8,2)
.W ?43,$J(BARNPCNT,4)
.W ?48,"$"_$J(BARNPAMT,8,2)
.W ?59,$J(BARTPCNT,6)
.W ?66,"$"_$J(BARTPAMT,10,2)
;
I CATEGORY="AAZERO" D
.W ?7,$J(BARZPCNT,6)
.W ?14,"$"_$J(BARZPAMT,10,2)
.W ?27,$J(BARZDCNT,4)
.W ?32,"$"_$J(BARZDAMT,8,2)
.W ?43,$J(BARZNCNT,4)
.W ?48,"$"_$J(BARZNAMT,8,2)
.W ?59,$J(BARZPCNT,6)
.W ?66,"$"_$J(BARZPAMT,10,2)
;
I CATEGORY="ADJZERO" D
.W ?7,$J(BARZACNT,6)
.W ?14,"$"_$J(BARZAAMT,10,2)
.W ?27,$J(BARZDCNT,4)
.W ?32,"$"_$J(BARZDAMT,8,2)
.W ?43,$J(BARZNCNT,4)
.W ?48,"$"_$J(BARZNAMT,8,2)
.W ?59,$J(BARZACNT,6)
.W ?66,"$"_$J(BARZAAMT,10,2)
;
I $P(CATEGORY," ")="ADJ" D
.W ?7,$J(ADJACNT,6)
.W ?14,"$"_$J(ADJAAMT,10,2)
.W ?27,$J(BARDACNT,4)
.W ?32,"$"_$J(BARDAAMT,8,2)
.W ?43,$J(ADJNCNT,4)
.W ?48,"$"_$J(ADJNAMT,8,2)
.W ?59,$J(ADJTCNT,6)
.W ?66,"$"_$J(ADJTAMT,10,2)
;
I $P(CATEGORY," ")="ZZZ" D
.W ?7,$J(REFACNT,6)
.W ?14,"$"_$J(REFAAMT,10,2)
.W ?27,$J(BARDRCNT,4)
.W ?32,"$"_$J(BARDRAMT,8,2)
.W ?43,$J(REFNCNT,4)
.W ?48,"$"_$J(REFNAMT,8,2)
.W ?59,$J(REFTCNT,6)
.W ?66,"$"_$J(REFTAMT,10,2)
;
I $P(CATEGORY," ")="RRR" D
.W ?7,$J(BARRCCNT,6)
.W ?14,"$"_$J(BARRCAMT,10,2)
.W ?27,$J(BARDCCNT,4)
.W ?32,"$"_$J(BARDCAMT,8,2)
.W ?43,$J(BARCNCNT,4)
.W ?48,"$"_$J(BARCNAMT,8,2)
.W ?59,$J(BARCTCNT,6)
.W ?66,"$"_$J(BARCTAMT,10,2)
Q
BARUFRP3 ; IHS/SD/TPF - UFMS REPORTS SECONDARY CALLS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,13,20,22,23**;OCT 26, 2005;Build 38
+2 ; FEB 2013 P.OTT CHANGED PTR TO INSURER TYPE
+3 QUIT
GRNTOT ;EP;
+1 KILL PAGE
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE=Y
+3 SET Y=START
XECUTE ^DD("DD")
SET EXSTART=Y
+4 SET Y=END
XECUTE ^DD("DD")
SET EXEND=Y
+5 SET ESC=0
+6 SET RPTTYP="G"
+7 DO BATHDR^BARUFRPT(DATE,RPTTYP)
+8 IF END'[(".")
SET END=END_".999999"
+9 DO SUMINIT^BARUFRPT
+10 WRITE !,"TRANSMISSIONS:"
+11 SET BATCH=START-.000001
+12 FOR
SET BATCH=$ORDER(^BARSESS(DUZ(2),"F",BATCH))
IF 'BATCH!(ESC)!(BATCH>END)
QUIT
Begin DoDot:1
+13 WRITE !?2,$$TDT^BARDUTL(BATCH)
+14 SET UDUZ=""
+15 FOR
SET UDUZ=$ORDER(^BARSESS(DUZ(2),"F",BATCH,UDUZ))
IF 'UDUZ!(ESC)
QUIT
Begin DoDot:2
+16 SET SESSID=""
+17 FOR
SET SESSID=$ORDER(^BARSESS(DUZ(2),"F",BATCH,UDUZ,SESSID))
IF 'SESSID!(ESC)
QUIT
Begin DoDot:3
+18 SET TRDATE=0
+19 FOR
SET TRDATE=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE))
IF 'TRDATE!(ESC)
QUIT
Begin DoDot:4
+20 ;IHS/SD/PKD 11/30/10 1.8*20 HEAT P/U TRX ONLY IF IN EXPORT DATE RANGE
+21 NEW TRQUIT
SET TRQUIT=^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)
+22 ; Not Transmitted
IF $PIECE(TRQUIT,U,2)'=1
QUIT
+23 ; Date this TRX went to UFMS
SET TRQUIT=$PIECE(TRQUIT,U,4)
+24 IF TRQUIT<(START-.000001)!(TRQUIT>END)
QUIT
+25 ; END 1.8*20
+26 SET IENS=TRDATE_","
+27 DO GETDATA
+28 IF 'BILL
QUIT
+29 IF $Y>(IOSL-4)
WRITE !
IF $DATA(IO("S"))
DO BATHDR^BARUFRPT(DATE,RPTTYP)
IF $DATA(IO("S"))
QUIT
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)&(IO=IO(0))
DO ^DIR
SET ESC=X=U
IF ESC
QUIT
DO BATHDR^BARUFRPT(DATE,RPTTYP)
+30 DO COUNT^BARUFRPT(.TOTALS)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;start old code bar*1.8*22 HEAT51432 (IHS/SD/NKD) DS were doubling on GTOT
+32 ;S TRDATE=0
+33 ;F S TRDATE=$O(^BARSESS(DUZ(2),"DS",TRDATE)) Q:'TRDATE!(ESC)!(TRDATE>END) D
+34 ;.S SESSID=""
+35 ;.F S SESSID=$O(^BARSESS(DUZ(2),"DS",TRDATE,SESSID)) Q:'SESSID!(ESC) D
+36 ;..S UDUZ=""
+37 ;..F S UDUZ=$O(^BARSESS(DUZ(2),"DS",TRDATE,SESSID,UDUZ)) Q:'UDUZ!(ESC) D
+38 ;...I $P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)="" Q
+39 ;...I '$D(BARFLST($P($G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8))) Q
+40 ;...S IENS=TRDATE_","
+41 ;...D GETDATA
+42 ;...Q:'BILL
+43 ;...I $Y>(IOSL-4) W ! D:$D(IO("S")) BATHDR^BARUFRPT(DATE,RPTTYP) Q:$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED)&(IO=IO(0)) ^DIR S ESC=X=U Q:ESC D BATHDR^BARUFRPT(DATE,RPTTYP)
+44 ;...D COUNT^BARUFRPT(.TOTALS)
+45 ;end old code HEAT51432
+46 WRITE !,DASH,!,?10,"SESSION TOTALS",?30,"DS TOTALS",?46,"NS TOTALS",?63,"TRANS. TOTALS",!,DASH
+47 DO LIST^BARUFRPT(.TOTALS)
+48 ;flush buffer
IF $DATA(IO("S"))
WRITE @IOF
+49 QUIT
+50 ;
GETDATA ;
+1 SET CREDIT=$$GET1^DIQ(90050.03,IENS,2)
+2 SET DEBIT=$$GET1^DIQ(90050.03,IENS,3)
+3 SET (CREDDEBT,AMT)=$$GET1^DIQ(90050.03,IENS,3.5,"E")
+4 SET BILL=$$GET1^DIQ(90050.03,IENS,4)
+5 IF 'BILL
QUIT
+6 SET BLLIEN=$$GET1^DIQ(90050.03,IENS,4,"I")
+7 SET ENTRYBY=$$GET1^DIQ(90050.03,IENS,13,"E")
+8 SET TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
+9 SET TRANTYP=$$GET1^DIQ(90050.03,IENS,101,"E")
+10 SET ADJCAT=$$GET1^DIQ(90050.03,IENS,102,"E")
+11 SET BARIIEN=$$INSIEN^BARUTL("BILL",BLLIEN,DUZ(2))
+12 IF BARIIEN'=""
Begin DoDot:1
+13 ;RETURNS NUM PTR (I.E. 21) P.OTT GET INS TYP
SET BARALLC=$$GET1^DIQ(9999999.18,BARIIEN,.211,"I")
+14 ;W !,"ABARALLC(1)=",BARALLC ;P.OTT
+15 ;NUMBER-->"INDIAN PATIENT^I"
SET BARALLC=$PIECE($GET(^AUTTINTY(BARALLC,0)),U,2)
+16 ;W !,"ABARALLC(2)=",BARALLC
+17 ;ALL CAT
SET BARALLC=$PIECE($TEXT(@BARALLC^BARRNEGB),";;",2)
+18 ;W " ABARALLC(3)=",BARALLC
End DoDot:1
+19 ;default, just in case ;IHS/SD/TPF BAR*1.8*13 4/21/2009
IF $GET(BARALLC)=""
SET BARALLC="OTHER"
+20 ;W " ABARALLC(FINAL)=",BARALLC R ASD
+21 QUIT
SETVAR ;EP;
+1 SET (ADJACNT,ADJAAMT,REFACNT,REFAAMT)=0
+2 SET (BARAPCNT,BARAPAMT)=0
+3 SET (BARRCCNT,BARRCAMT)=0
+4 SET (BARNPCNT,BARNPAMT,BARTPCNT,BARTPAMT)=0
+5 SET (REFTCNT,REFTAMT,REFNCNT,REFNAMT)=0
+6 SET (ADJTCNT,ADJTAMT,ADJNCNT,ADJNAMT)=0
+7 SET (BARCACNT,BARCAAMT,BARCNCNT,BARCNAMT,BARCTCNT,BARCTAMT)=0
+8 SET (BARDPCNT,BARDPAMT,BARDACNT,BARDAAMT,BARDRCNT,BARDRAMT,BARDCCNT,BARDCAMT)=0
+9 SET (BARZPCNT,BARZPAMT,BARZDCNT,BARZDAMT,BARZNCNT,BARZNAMT)=0
+10 SET (BARZACNT,BARZAAMT,BARZDCNT,BARZDAMT,BARZNAMT)=0
+11 QUIT
TOT ;EP;
+1 IF $PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)=""
Begin DoDot:1
+2 SET TOTALS(CAT,BARALLC,"ALL")=$GET(TOTALS(CAT,BARALLC,"ALL"))+AMT
+3 SET TOTALS(CAT,BARALLC,"ALL","CNT")=$GET(TOTALS(CAT,BARALLC,"ALL","CNT"))+1
End DoDot:1
+4 IF CAT="AAZERO"
Begin DoDot:1
+5 SET TOTALS(CAT,BARALLC,"ZP")=$GET(TOTALS(CAT,BARALLC,"ZP"))+AMT
+6 SET TOTALS(CAT,BARALLC,"ZP","CNT")=$GET(TOTALS(CAT,BARALLC,"ZP","CNT"))+1
End DoDot:1
+7 IF CAT="ADJZERO"
Begin DoDot:1
+8 SET TOTALS(CAT,BARALLC,"ZA")=$GET(TOTALS(CAT,BARALLC,"ZA"))+AMT
+9 SET TOTALS(CAT,BARALLC,"ZA","CNT")=$GET(TOTALS(CAT,BARALLC,"ZA","CNT"))+1
End DoDot:1
+10 IF $PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,8)'=""
Begin DoDot:1
+11 SET TOTALS(CAT,BARALLC,"DS","CNT")=$GET(TOTALS(CAT,BARALLC,"DS","CNT"))+1
+12 SET TOTALS(CAT,BARALLC,"DS")=$GET(TOTALS(CAT,BARALLC,"DS"))+AMT
End DoDot:1
+13 IF $PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,6)=1!(TRANTYP="REMARK CODE")
Begin DoDot:1
+14 SET TOTALS(CAT,BARALLC,"NS","CNT")=$GET(TOTALS(CAT,BARALLC,"NS","CNT"))+1
+15 SET TOTALS(CAT,BARALLC,"NS")=$GET(TOTALS(CAT,BARALLC,"NS"))+AMT
End DoDot:1
+16 IF $PIECE($GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,TRDATE,0)),U,6)'=1
IF ((TRANTYP'="REMARK CODE")!(CAT'="ZERO"))
Begin DoDot:1
+17 SET TOTALS(CAT,BARALLC,"TR","CNT")=$GET(TOTALS(CAT,BARALLC,"TR","CNT"))+1
+18 SET TOTALS(CAT,BARALLC,"TR")=$GET(TOTALS(CAT,BARALLC,"TR"))+AMT
End DoDot:1
+19 QUIT
WRITEDET ;EP;
+1 ;P.OTT
WRITE !?2,$SELECT(BARALLC["VETERAN":"VET",BARALLC["PRIVATE":"PVT",BARALLC["MEDICARE":"MCR",BARALLC["MEDICAID":"MCD",1:"OTH")
+2 WRITE ?7,$JUSTIFY(TOTALS(CATEGORY,BARALLC,"ALL","CNT"),6)
+3 WRITE ?14,"$"_$JUSTIFY(TOTALS(CATEGORY,BARALLC,"ALL"),10,2)
+4 WRITE ?27,$JUSTIFY(TOTALS(CATEGORY,BARALLC,"DS","CNT"),4)
+5 WRITE ?32,"$"_$JUSTIFY(TOTALS(CATEGORY,BARALLC,"DS"),8,2)
+6 WRITE ?43,$JUSTIFY($SELECT(CATEGORY="AAZERO":BARZPCNT,CATEGORY="ADJZERO":BARZACNT,1:TOTALS(CATEGORY,BARALLC,"NS","CNT")),4)
+7 WRITE ?48,"$"_$JUSTIFY($SELECT(CATEGORY="AAZERO":BARZPAMT,CATEGORY="ADJZERO":BARZAAMT,1:TOTALS(CATEGORY,BARALLC,"NS")),8,2)
+8 WRITE ?59,$JUSTIFY(TOTALS(CATEGORY,BARALLC,"TR","CNT"),6)
+9 WRITE ?66,"$"_$JUSTIFY(TOTALS(CATEGORY,BARALLC,"TR"),10,2)
+10 QUIT
WRITETOT ;EP;
+1 WRITE !,?7,"------------------"
+2 WRITE ?27,"--------------"
+3 WRITE ?43,"--------------"
+4 WRITE ?59,"------------------"
+5 WRITE !?2,"TOTAL"
+6 IF $PIECE(CATEGORY," ")="AAA"
Begin DoDot:1
+7 WRITE ?7,$JUSTIFY(BARAPCNT,6)
+8 WRITE ?14,"$"_$JUSTIFY(BARAPAMT,10,2)
+9 WRITE ?27,$JUSTIFY(BARDPCNT,4)
+10 WRITE ?32,"$"_$JUSTIFY(BARDPAMT,8,2)
+11 WRITE ?43,$JUSTIFY(BARNPCNT,4)
+12 WRITE ?48,"$"_$JUSTIFY(BARNPAMT,8,2)
+13 WRITE ?59,$JUSTIFY(BARTPCNT,6)
+14 WRITE ?66,"$"_$JUSTIFY(BARTPAMT,10,2)
End DoDot:1
+15 ;
+16 IF CATEGORY="AAZERO"
Begin DoDot:1
+17 WRITE ?7,$JUSTIFY(BARZPCNT,6)
+18 WRITE ?14,"$"_$JUSTIFY(BARZPAMT,10,2)
+19 WRITE ?27,$JUSTIFY(BARZDCNT,4)
+20 WRITE ?32,"$"_$JUSTIFY(BARZDAMT,8,2)
+21 WRITE ?43,$JUSTIFY(BARZNCNT,4)
+22 WRITE ?48,"$"_$JUSTIFY(BARZNAMT,8,2)
+23 WRITE ?59,$JUSTIFY(BARZPCNT,6)
+24 WRITE ?66,"$"_$JUSTIFY(BARZPAMT,10,2)
End DoDot:1
+25 ;
+26 IF CATEGORY="ADJZERO"
Begin DoDot:1
+27 WRITE ?7,$JUSTIFY(BARZACNT,6)
+28 WRITE ?14,"$"_$JUSTIFY(BARZAAMT,10,2)
+29 WRITE ?27,$JUSTIFY(BARZDCNT,4)
+30 WRITE ?32,"$"_$JUSTIFY(BARZDAMT,8,2)
+31 WRITE ?43,$JUSTIFY(BARZNCNT,4)
+32 WRITE ?48,"$"_$JUSTIFY(BARZNAMT,8,2)
+33 WRITE ?59,$JUSTIFY(BARZACNT,6)
+34 WRITE ?66,"$"_$JUSTIFY(BARZAAMT,10,2)
End DoDot:1
+35 ;
+36 IF $PIECE(CATEGORY," ")="ADJ"
Begin DoDot:1
+37 WRITE ?7,$JUSTIFY(ADJACNT,6)
+38 WRITE ?14,"$"_$JUSTIFY(ADJAAMT,10,2)
+39 WRITE ?27,$JUSTIFY(BARDACNT,4)
+40 WRITE ?32,"$"_$JUSTIFY(BARDAAMT,8,2)
+41 WRITE ?43,$JUSTIFY(ADJNCNT,4)
+42 WRITE ?48,"$"_$JUSTIFY(ADJNAMT,8,2)
+43 WRITE ?59,$JUSTIFY(ADJTCNT,6)
+44 WRITE ?66,"$"_$JUSTIFY(ADJTAMT,10,2)
End DoDot:1
+45 ;
+46 IF $PIECE(CATEGORY," ")="ZZZ"
Begin DoDot:1
+47 WRITE ?7,$JUSTIFY(REFACNT,6)
+48 WRITE ?14,"$"_$JUSTIFY(REFAAMT,10,2)
+49 WRITE ?27,$JUSTIFY(BARDRCNT,4)
+50 WRITE ?32,"$"_$JUSTIFY(BARDRAMT,8,2)
+51 WRITE ?43,$JUSTIFY(REFNCNT,4)
+52 WRITE ?48,"$"_$JUSTIFY(REFNAMT,8,2)
+53 WRITE ?59,$JUSTIFY(REFTCNT,6)
+54 WRITE ?66,"$"_$JUSTIFY(REFTAMT,10,2)
End DoDot:1
+55 ;
+56 IF $PIECE(CATEGORY," ")="RRR"
Begin DoDot:1
+57 WRITE ?7,$JUSTIFY(BARRCCNT,6)
+58 WRITE ?14,"$"_$JUSTIFY(BARRCAMT,10,2)
+59 WRITE ?27,$JUSTIFY(BARDCCNT,4)
+60 WRITE ?32,"$"_$JUSTIFY(BARDCAMT,8,2)
+61 WRITE ?43,$JUSTIFY(BARCNCNT,4)
+62 WRITE ?48,"$"_$JUSTIFY(BARCNAMT,8,2)
+63 WRITE ?59,$JUSTIFY(BARCTCNT,6)
+64 WRITE ?66,"$"_$JUSTIFY(BARCTAMT,10,2)
End DoDot:1
+65 QUIT
