- RCRCXM1 ;ALB/CMS - AR/RC ORIGINAL TRANSMISSION SET ;09/08/97
- V ;;4.5;Accounts Receivable;**63,122,189,249,263**;Mar 20, 1995;Build 2
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- ;
- IBS ;Set the IB Bill Information data line from RCRCVXM
- ;Return: ^TMP("RCRCVL",$J,"XM")
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,1,1)="BN1^BILL#^CAT.ABB^STATUS.ABB^CURRENT BALANCE^BILL TYPE^FORM TYPE^BILL DATE FROM^BILL DATE TO"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,1,2)="BN2^TOTAL BILL CHARGES^OFFSET AMT^OFFSET DESC.^DATE FIRST PRINTED^TAX ID^REFERRAL REASON CODE^REFERRAL COMMENT"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,2,1)="BINS^NAME OF INSURED^SUBSCRIBER ID#^RELATIONSHIP TO INSURED^CONDITION RELATED TO^"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,3,1)="PAT^PAT NAME^SSN^DOB^SEX^SENSITIVE RECORD Y/N^ADD1^ADD2^ADD3^CITY^STATE^ZIP"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,4,1)="INS^INSURER NAME^ADD1^ADD2^ADD3^CITY^STATE^ZIP^PHONE^PROVIDER ID#^GROUP NAME^GROUP #"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,5,1)="INSUP^DEBTNAME^DEBT ADD1^DEBT ADD2^DEBT ADD3^CITY^STATE^ZIP^PHONE
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,6,1)="OPV^1^OPV DATE1"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,6,2)="OPV^2^OPV DATE2"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,7,1)="DXS^1^DIAGNOSIS CODE^DESCRIPTION"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,7,2)="DXS^2^DIAGNOSIS CODE^DESCRIPTION"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,8,1)="RVC^1^REVENUE CODE^DESCRIPTION^RATE^UNITS^TOTAL CHARGES"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,8,2)="RVC^2^REVENUE CODE^DESCRIPTION^RATE^UNITS^TOTAL CHARGES"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,9,1)="PRC^1^PROCEDURE CODE^PROCEDURE DATE^PLACE OF SERVICE CODE^PLACE OF SERVICE^TYPE OF SERVICE CODE^TYPE OF SERVICE"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,9,2)="PRC^2^PROCEDURE CODE^PROCEDURE DATE^PLACE OF SERVICE CODE^PLACE OF SERVICE^TYPE OF SERVICE CODE^TYPE OF SERVICE"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,10,1)="RXF^1^RX #^REFILL DATE^DRUG^NAME^DAYS SUPPLY^QUANTITY^NDC NUMBER"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,10,2)="RXF^2^RX #^REFILL DATE^DRUG^NAME^DAYS SUPPLY^QUANTITY^NDC NUMBER"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,11,1)="PRD^1^PROSTHETIC DEVICE NAME^DELIVERY DATE"
- ;S ^TMP("RCRCVL",$J,"XM",PRCABN,11,2)="PRD^2^PROSTHETIC DEVICE NAME^DELIVERY DATE"
- ;
- N RCDR,RCI,RCIB,RCUNK S RCIB=""
- D BILL^IBRFN3(PRCABN,.RCIB)
- S RCUNK="UNK"
- I RCIB=0 S RCA(PRCABN,RCY)="No IB Bill/Claim Information" G IBSQ
- ; - allow sites to refer bill but not electronically
- I $P($G(RCCAT(+$G(PRCA("CAT")))),U,1)'=1 S ^TMP("RCRCVL",$J,"XM",PRCABN,0)=RCY G IBSQ
- ; - set XM primary bill information
- S RCCNT=RCCNT+1
- S ^TMP("RCRCVL",$J,"XM",PRCABN,0)=RCY
- S RCDR="BN1^"_$G(PRCA("BNAME"),RCUNK)_U_$P($G(PRCA("CAT")),U,3)_U_$P($G(PRCA("STATUS")),U,3)_U_+$P($$BILL^RCJIBFN2(PRCABN),U,3)_U_$G(RCIB("TOC"))_U_$G(RCIB("TCF"))_U_$G(RCIB("STF"))_U_$G(RCIB("STT"))
- S ^TMP("RCRCVL",$J,"XM",PRCABN,1,1)=RCDR S RCDR=""
- S ^TMP("RCRCVL",$J,"XM",PRCABN,1,2)="BN2^"_$G(RCIB("TCG"))_U_$G(RCIB("DFP"))_U_$G(RCIB("TAX"))_U_$G(PRCA("REF REASON"))
- S ^TMP("RCRCVL",$J,"XM",PRCABN,2,1)="BINS^"_$P($G(RCIB("PIN")),U,5)_U_$P($G(RCIB("PIN")),U,6)_U_$P($G(RCIB("PIN")),U,7)_U_$S($G(RCIB("CRE"))]"":RCIB("CRE"),$G(RCIB("CRA"))]"":RCIB("CRA"),$G(RCIB("CRO"))]"":RCIB("CRO"),1:"")
- S ^TMP("RCRCVL",$J,"XM",PRCABN,3,1)="PAT^"_$E($G(VADM(1),RCUNK),1,30)_U_$P($G(VADM(2)),U,1)_U_$P($G(VADM(3)),U,1)_U_$P($G(VADM(5)),U)_U_$G(RCIB("SR"))_U_$G(VAPA(1))_U_$G(VAPA(2))_U_$G(VAPA(3))_U_$G(VAPA(4))_U_$P($G(VAPA(5)),U,2)_U_+$G(VAPA(6))
- S ^TMP("RCRCVL",$J,"XM",PRCABN,4,1)="INS^"_$P($G(RCIB("PIN")),U,1)_U_$G(RCIB("PIN","MMA"))_U_$P($G(RCIB("PIN")),U,2,4)
- ;
- ; - set multiples if defined
- I $O(RCIB("OPV",0)) S RCI=0 F S RCI=$O(RCIB("OPV",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,6,RCI)="OPV^"_RCI_U_RCIB("OPV",RCI)
- I $O(RCIB("DXS",0)) S RCI=0 F S RCI=$O(RCIB("DXS",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,7,RCI)="DXS^"_RCI_U_RCIB("DXS",RCI)
- I $O(RCIB("RVC",0)) S RCI=0 F S RCI=$O(RCIB("RVC",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,8,RCI)="RVC^"_RCI_U_RCIB("RVC",RCI)
- I $O(RCIB("PRC",0)) S RCI=0 F S RCI=$O(RCIB("PRC",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,9,RCI)="PRC^"_RCI_U_RCIB("PRC",RCI)
- I $O(RCIB("RXF",0)) S RCI=0 F S RCI=$O(RCIB("RXF",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,10,RCI)="RXF^"_RCI_U_RCIB("RXF",RCI)
- I $O(RCIB("PRD",0)) S RCI=0 F S RCI=$O(RCIB("PRD",RCI)) Q:'RCI D
- .S ^TMP("RCRCVL",$J,"XM",PRCABN,11,RCI)="PRD^"_RCI_U_RCIB("PRD",RCI)
- ;
- ; - set Current Debtor Name and Address if different
- S RCI=""
- I $G(PRCA("DEBTNM"))'=$P($G(RCIB("PIN")),U,1) S RCI=1
- I 'RCI,$G(PRCA("DEBTAD1"))'=$P($G(RCIB("PIN","MMA")),U,1) S RCI=1
- I 'RCI,$P($G(PRCA("DEBTADD")),U,7)'=$P($G(PRCA("PIN","MMA")),U,7)
- I RCI S ^TMP("RCRCVL",$J,"XM",PRCABN,5,1)="INSUP^"_$E($G(PRCA("DEBTNM")),1,30)_U_$G(PRCA("DEBTAD1"))_U_$G(PRCA("DEBTAD2"))_U_$G(PRCA("DEBTAD3"))_U_$G(PRCA("DEBTCT"))_U_$G(PRCA("DEBTST"))_U_$G(PRCA("DEBTZIP"))_U_$P($G(PRCA("DEBTADD")),U,7)
- ;
- IBSQ K DFN,PRCA,RCCAT,VA,VADM,VAPA
- Q
- ;RCRCXM1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCXM1 5001 printed Feb 18, 2025@23:14:24 Page 2
- RCRCXM1 ;ALB/CMS - AR/RC ORIGINAL TRANSMISSION SET ;09/08/97
- V ;;4.5;Accounts Receivable;**63,122,189,249,263**;Mar 20, 1995;Build 2
- +1 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +2 ;
- +3 QUIT
- +4 ;
- IBS ;Set the IB Bill Information data line from RCRCVXM
- +1 ;Return: ^TMP("RCRCVL",$J,"XM")
- +2 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,1,1)="BN1^BILL#^CAT.ABB^STATUS.ABB^CURRENT BALANCE^BILL TYPE^FORM TYPE^BILL DATE FROM^BILL DATE TO"
- +3 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,1,2)="BN2^TOTAL BILL CHARGES^OFFSET AMT^OFFSET DESC.^DATE FIRST PRINTED^TAX ID^REFERRAL REASON CODE^REFERRAL COMMENT"
- +4 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,2,1)="BINS^NAME OF INSURED^SUBSCRIBER ID#^RELATIONSHIP TO INSURED^CONDITION RELATED TO^"
- +5 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,3,1)="PAT^PAT NAME^SSN^DOB^SEX^SENSITIVE RECORD Y/N^ADD1^ADD2^ADD3^CITY^STATE^ZIP"
- +6 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,4,1)="INS^INSURER NAME^ADD1^ADD2^ADD3^CITY^STATE^ZIP^PHONE^PROVIDER ID#^GROUP NAME^GROUP #"
- +7 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,5,1)="INSUP^DEBTNAME^DEBT ADD1^DEBT ADD2^DEBT ADD3^CITY^STATE^ZIP^PHONE
- +8 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,6,1)="OPV^1^OPV DATE1"
- +9 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,6,2)="OPV^2^OPV DATE2"
- +10 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,7,1)="DXS^1^DIAGNOSIS CODE^DESCRIPTION"
- +11 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,7,2)="DXS^2^DIAGNOSIS CODE^DESCRIPTION"
- +12 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,8,1)="RVC^1^REVENUE CODE^DESCRIPTION^RATE^UNITS^TOTAL CHARGES"
- +13 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,8,2)="RVC^2^REVENUE CODE^DESCRIPTION^RATE^UNITS^TOTAL CHARGES"
- +14 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,9,1)="PRC^1^PROCEDURE CODE^PROCEDURE DATE^PLACE OF SERVICE CODE^PLACE OF SERVICE^TYPE OF SERVICE CODE^TYPE OF SERVICE"
- +15 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,9,2)="PRC^2^PROCEDURE CODE^PROCEDURE DATE^PLACE OF SERVICE CODE^PLACE OF SERVICE^TYPE OF SERVICE CODE^TYPE OF SERVICE"
- +16 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,10,1)="RXF^1^RX #^REFILL DATE^DRUG^NAME^DAYS SUPPLY^QUANTITY^NDC NUMBER"
- +17 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,10,2)="RXF^2^RX #^REFILL DATE^DRUG^NAME^DAYS SUPPLY^QUANTITY^NDC NUMBER"
- +18 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,11,1)="PRD^1^PROSTHETIC DEVICE NAME^DELIVERY DATE"
- +19 ;S ^TMP("RCRCVL",$J,"XM",PRCABN,11,2)="PRD^2^PROSTHETIC DEVICE NAME^DELIVERY DATE"
- +20 ;
- +21 NEW RCDR,RCI,RCIB,RCUNK
- SET RCIB=""
- +22 DO BILL^IBRFN3(PRCABN,.RCIB)
- +23 SET RCUNK="UNK"
- +24 IF RCIB=0
- SET RCA(PRCABN,RCY)="No IB Bill/Claim Information"
- GOTO IBSQ
- +25 ; - allow sites to refer bill but not electronically
- +26 IF $PIECE($GET(RCCAT(+$GET(PRCA("CAT")))),U,1)'=1
- SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,0)=RCY
- GOTO IBSQ
- +27 ; - set XM primary bill information
- +28 SET RCCNT=RCCNT+1
- +29 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,0)=RCY
- +30 SET RCDR="BN1^"_$GET(PRCA("BNAME"),RCUNK)_U_$PIECE($GET(PRCA("CAT")),U,3)_U_$PIECE($GET(PRCA("STATUS")),U,3)_U_+$PIECE($$BILL^RCJIBFN2(PRCABN),U,3)_U_$GET(RCIB("TOC"))_U_$GET(RCIB("TCF"))_U_$GET(RCIB("STF"))_U_$GET(RCIB("STT"))
- +31 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,1,1)=RCDR
- SET RCDR=""
- +32 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,1,2)="BN2^"_$GET(RCIB("TCG"))_U_$GET(RCIB("DFP"))_U_$GET(RCIB("TAX"))_U_$GET(PRCA("REF REASON"))
- +33 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,2,1)="BINS^"_$PIECE($GET(RCIB("PIN")),U,5)_U_$PIECE($GET(RCIB("PIN")),U,6)_U_$PIECE($GET(RCIB("PIN")),U,7)_U_$SELECT(...
- ... $GET(RCIB("CRE"))]"":RCIB("CRE"),$GET(RCIB("CRA"))]"":RCIB("CRA"),$GET(RCIB("CRO"))]"":RCIB("CRO"),1:"")
- +34 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,3,1)="PAT^"_$EXTRACT(...
- ... $GET(VADM(1),RCUNK),1,30)_U_$PIECE($GET(VADM(2)),U,1)_U_$PIECE($GET(VADM(3)),U,1)_U_$PIECE($GET(VADM(5)),U)_U_$GET(RCIB("SR"))_U_$GET(VAPA(1))_U_$GET(VAPA(2))_U_$GET(VAPA(3))_U_$GET(VAPA(4))_U_$PIECE($GET(VAPA(5)),U,2)_U_+$GET(VAPA(6))
- +35 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,4,1)="INS^"_$PIECE($GET(RCIB("PIN")),U,1)_U_$GET(RCIB("PIN","MMA"))_U_$PIECE($GET(RCIB("PIN")),U,2,4)
- +36 ;
- +37 ; - set multiples if defined
- +38 IF $ORDER(RCIB("OPV",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("OPV",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +39 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,6,RCI)="OPV^"_RCI_U_RCIB("OPV",RCI)
- End DoDot:1
- +40 IF $ORDER(RCIB("DXS",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("DXS",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +41 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,7,RCI)="DXS^"_RCI_U_RCIB("DXS",RCI)
- End DoDot:1
- +42 IF $ORDER(RCIB("RVC",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("RVC",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +43 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,8,RCI)="RVC^"_RCI_U_RCIB("RVC",RCI)
- End DoDot:1
- +44 IF $ORDER(RCIB("PRC",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("PRC",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +45 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,9,RCI)="PRC^"_RCI_U_RCIB("PRC",RCI)
- End DoDot:1
- +46 IF $ORDER(RCIB("RXF",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("RXF",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +47 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,10,RCI)="RXF^"_RCI_U_RCIB("RXF",RCI)
- End DoDot:1
- +48 IF $ORDER(RCIB("PRD",0))
- SET RCI=0
- FOR
- SET RCI=$ORDER(RCIB("PRD",RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +49 SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,11,RCI)="PRD^"_RCI_U_RCIB("PRD",RCI)
- End DoDot:1
- +50 ;
- +51 ; - set Current Debtor Name and Address if different
- +52 SET RCI=""
- +53 IF $GET(PRCA("DEBTNM"))'=$PIECE($GET(RCIB("PIN")),U,1)
- SET RCI=1
- +54 IF 'RCI
- IF $GET(PRCA("DEBTAD1"))'=$PIECE($GET(RCIB("PIN","MMA")),U,1)
- SET RCI=1
- +55 IF 'RCI
- IF $PIECE($GET(PRCA("DEBTADD")),U,7)'=$PIECE($GET(PRCA("PIN","MMA")),U,7)
- +56 IF RCI
- SET ^TMP("RCRCVL",$JOB,"XM",PRCABN,5,1)="INSUP^"_$EXTRACT($GET(PRCA("DEBTNM")),1,30)_U_$GET(PRCA("DEBTAD1"))_U_$GET(PRCA("DEBTAD2"))_U_$GET(PRCA("DEBTAD3"))_U_...
- ... $GET(PRCA("DEBTCT"))_U_$GET(PRCA("DEBTST"))_U_$GET(PRCA("DEBTZIP"))_U_$PIECE($GET(PRCA("DEBTADD")),U,7)
- +57 ;
- IBSQ KILL DFN,PRCA,RCCAT,VA,VADM,VAPA
- +1 QUIT
- +2 ;RCRCXM1