- 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
