IBACCWLBILLVE ;EDE/TAZ - ACC (Automated Community Care) Claims - VIEW ENCOUNTER ; 12-SEP-2023 ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;THIS ROUTINE ALLOWS THE USER TO VIEW THE X12 ENCOUNTER IN READABLE FORMAT.
;
;
;S SESSIONKEY="IBACCBILL",IBENCIFN=56620 D EN^IBACCWLBILLVE
EN ;
N D,D1,SBR,VALMAR,VALMCNT,VALMHDR,VALMSG
;
N IBPARENT S IBPARENT=0 ;TPF;IB*2*770vPURPLE;EBILL-5385 EE DISPLAYS ONE RECORD
S IBACCWLBILLVELEV=$G(IBACCWLBILLVELEV)+1
;
D EN^VALM("IBACC WL VE BILLING")
;
Q
;
HDR ; -- header code
;
S VALMHDR(1)="Special Billing View X12 Encounter Data"
;
Q
;
INIT ;EP -- init variables and list array
N CLM,CLMCNT,CODE,D,D1,HI,HL,IOD,LINEVAR,NODE,SBR,TAX
N DIAGPTRARR,IBFORM ;TPF;IB*27*70v38;EBILL-5483 Diagnosis Code Pointer ARRAY
N DISUSERGROUP,IBTYPEFORM,IBINOUT,USERGROUP ;TPF;IB*2*770v53;EBILL-6203
;
S IBFORM=$$GET1^DIQ(364.9,IBENCIFN,.06,"E") ;CMS-1500, UB-04 OR D
S IBINOUT=$$GET1^DIQ(364.9,IBENCIFN,.05,"I") ;I OR O
S IBTYPEFORM="|"_IBINOUT_"_"_$P(IBFORM,"-")_"|"
;
;BEGIN TPF;IB*2*770v53;EBILL-6203
S USERGROUP=$P(SESSIONKEY,"IBACC",2)
S DISUSERGROUP=$$DISUSERGROUP^IBACCWLBILLVE1A(USERGROUP)
S VALM("TITLE")=" ACC "_DISUSERGROUP_" View Encounter"
N INCLUDE D GETINCLUSIONS^IBACCWLBILLVE1A(.INCLUDE,USERGROUP,IBINOUT,IBFORM)
;
I '$D(INCLUDE) D Q
.W !!,"There are no inclusion parameters set up for"
.W !,"Form: ",$G(IBFORM)
.W !,"Pat Type: ",$G(IBINOUT)
.N DIR
.D PAUSE^VALM1
.S VALMBCK="Q"
;END TPF;IB*2*770v53;EBILL-6203
;
S D="*",D1=":"
S (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0
S IOD=$$GET1^DIQ(364.9,IBENCIFN,.05,"I")
F S CLMCNT=$O(^IBA(364.9,IBENCIFN,1,CLMCNT)) Q:'CLMCNT S DATA=^(CLMCNT,0) Q:DATA="" D
. S NODE=$P(DATA,D,1)
. ;Nodes not processed: BHT,CUR,K3,SE,ST
. I ",AMT,CAS,CL1,CLM,CN1,CR1,CR2,CR3,CRC,CTP,DMG,DN1,DN2,DTP,FRM,HCP,HI,HL,LIN,LQ,LX,MEA,MIA,MOA,NM1,NTE,N3,N4,OI,PAT,PER,PRV,PS1,PWK,QTY,REF,SBR,SV1,SV2,SV3,SV5,SVD,TOO,"'[(","_NODE_",") Q
. I ",HI,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE1A" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
. ;I ",CAS,CLM,CRC,DTP,HCP,HI,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE1" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
. I ",CAS,CLM,CRC,DTP,HCP,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE1"
. I ",MIA,NM1,PWK,REF,SBR,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE2"
. ;I ",SV1,SV2,SV3,SV5,SVD,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE3"
. I ",SV1,SV2,SV3,SV5,SVD,NTE,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE3" ;TPF;IB*2*770v53;EBILL-6203
. D @NODE
;
D SET(""," ") ;TPF;IB*2*770v53;EBILL-6203
D SET(""," ") ;TPF;IB*2*770v53;EBILL-6203
;
;BEGIN TPF*IB*2*770v38;EBILL-5485,5721
I $G(IBENCIFN),($D(@VALMAR)) D
.N IBIFN
.S @VALMAR@("IEN3649",1)=IBENCIFN
.S IBIFN=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"I")
.S:$G(IBIFN) @VALMAR@("IEN399",1)=IBIFN
;END TPF*IB*2*770v38;EBILL-5485,5721
;
INITQ ;Exit
I '$D(@VALMAR) D SET^VALM10(1,"NO DATA FOUND!!")
Q
;
AMT ;Display Amount Patient Paid
S CODE=$P(DATA,D,2) D D SET(CODE,$$DOL($P(DATA,D,3)))
. I CODE="A8" S CODE="Noncovered Charges - Actual" Q
. I CODE="D" S CODE="Payor Amount Paid" Q
. I CODE="EAF" S CODE="Amount Owed" Q
. I CODE="F3" S CODE="Patient Responsibility - Estimated" Q
. I CODE="F4" S CODE="Postage Claimed Amount" Q
. I CODE="F5" S CODE="Patient Amount Paid" Q
. I CODE="GT" S CODE="Service Tax Amount" Q
. I CODE="N8" S CODE="Facility Tax Amount" Q
. I CODE="T" S CODE="Sales Tax Amount" Q
Q
;
CL1 ;Institutional Claim Code
D SET("Admission Type Code",$P(DATA,D,2))
D SET("Admission Source Code",$P(DATA,D,3))
D SET("Patient Status Code",$P(DATA,D,4))
Q
;
CN1 ;Display Contract Information
S CODE=$P(DATA,D,2) D D SET("Contract Type Code",CODE)
. I CODE="01" S CODE="Diagnosis Related Group (DRG)" Q
. I CODE="02" S CODE="Per Diem" Q
. I CODE="03" S CODE="Variable Per Diem" Q
. I CODE="04" S CODE="Flat" Q
. I CODE="05" S CODE="Capitated" Q
. I CODE="06" S CODE="Percent" Q
. I CODE="09" S CODE="Other" Q
. S CODE="UNKNOWN CODE"
I $P(DATA,D,3)'="" D SET("Contract Amount",$$DOL($P(DATA,D,3)))
I $P(DATA,D,4)'="" D SET("Contract Percentage",($P(DATA,D,4)*100)_"%")
I $P(DATA,D,5)'="" D SET("Contract Code",$P(DATA,D,5))
I $P(DATA,D,6)'="" D SET("Terms Discount Percentage",($P(DATA,D,6)*100)_"%")
I $P(DATA,D,7)'="" D SET("Contract Version Identifier",$P(DATA,D,7))
Q
;
CR1 ;Display Ambulance Transport Information
I $P(DATA,D,3)'="" D SET("Patient Weight",$P(DATA,D,3)_$S($P(DATA,D,2)="LB":" Pounds",1:""))
S CODE=$P(DATA,D,5) D D SET("Ambulance Transport Reason Code",CODE)
. I CODE="A" S CODE="Transported to Nearest Facility" Q
. I CODE="B" S CODE="Transported for Benefit of Preferred Physician" Q
. I CODE="C" S CODE="Transported for Nearness of Family Members" Q
. I CODE="D" S CODE="Transported for Care of a Specialist" Q
. I CODE="E" S CODE="Transferred to Rehabilitation Facility" Q
. S CODE="UNNKNOWN"
D SET("Transport Distance",$P(DATA,D,7)_$S($P(DATA,D,6)="DH":" Miles",1:""))
I $P(DATA,D,10)'="" D SET("Round Trip Purpose Description",$P(DATA,D,10))
I $P(DATA,D,11)'="" D SET("Stretcher Purpose Description",$P(DATA,D,11))
Q
;
CR2 ;Spinal Manipulation Service Information
S CODE=$P(DATA,D,9) D D SET("Patient Condition",CODE)
. I CODE="A" S CODE="Acute Condition" Q
. I CODE="C" S CODE="Chronic Condition" Q
. I CODE="D" S CODE="Non-Acute" Q
. I CODE="E" S CODE="Non-Life Threatening" Q
. I CODE="F" S CODE="Routine" Q
. I CODE="G" S CODE="Symptomatic" Q
. I CODE="M" S CODE="Acute Manifestation of a Chronic Condition" Q
. S CODE="UNKNOWN"
I $P(DATA,D,11)'="" D SET("Patient Condition Description",$P(DATA,D,11))
I $P(DATA,D,12)'="" D SET("",$P(DATA,D,12))
Q
;
CR3 ;Durable Medical Equipment Certification
S CODE=$P(DATA,D,2) D D SET("Certification Type Code",CODE)
. I CODE="I" S CODE="Initial" Q
. I CODE="R" S CODE="Renewal" Q
. I CODE="S" S CODE="Revised" Q
. S CODE="UNKNOWN"
D SET("Durable Medical Equipment Duration",$P(DATA,D,4)_$S($P(DATA,D,3)="MO":" Months",1:""))
Q
;
CTP ;Drug Quantity
N UNIT
S UNIT=$P($P(DATA,D,6),D1,1) D D SET("National Drug Unit Count",$P(DATA,D,5)_UNIT)
. I UNIT="F2" S UNIT=" International Unit(s)" Q
. I UNIT="GR" S UNIT=" Gram(s)" Q
. I UNIT="ME" S UNIT=" Milligram(s)" Q
. I UNIT="ML" S UNIT=" Mililiter(s)" Q
. I UNIT="UN" S UNIT=" Unit(s)"
. S UNIT=" "_UNIT
Q
;
DMG ;Demographics
D SET("Date of Birth",$$DATE($P(DATA,D,3)))
D SET("Gender",$S($P(DATA,D,4)="F":"Female",$P(DATA,D,4)="M":"Male",1:"Unknown"))
I $P(DATA,D,11)'="" D SET("Patient Condition Description",$P(DATA,D,11))
I $P(DATA,D,12)'="" D SET("Patient Condition Description",$P(DATA,D,12))
Q
;
DN1 ;Orthodontic Total Months of Treatment
S CODE=$P(DATA,D,2) I $L(CODE) D SET("Orthodontic Treatment Months Count",CODE)
S CODE=$P(DATA,D,3) I $L(CODE) D SET("Orthodontic Treatment Months Remaining Count",CODE)
S CODE=$P(DATA,D,5) I $L(CODE) D SET("Orthodontic Treatment Indicator",$$YN(CODE))
Q
;
DN2 ;Tooth Status
D SET("Tooth Number",$P(DATA,D,2))
S CODE=$P(DATA,D,3) D D SET("Tooth Status",CODE)
. I CODE="E" S CODE="To Be Extracted"
. I CODE="M" S CODE="Missing"
S CODE=$P(DATA,D,7) D D SET("Code List Qualifier Code",CODE)
. I CODE="JP" S CODE="Universal National Tooth Designation System" Q
Q
;
FRM ;Supporting Documentation
D SET("Question Number/Letter",$P(DATA,D,2))
S CODE=$P(DATA,D,3) I $L(CODE) D SET("Question Response",$$YN(CODE))
S CODE=$P(DATA,D,4) I $L(CODE) D SET("Question Response",CODE)
S CODE=$P(DATA,D,5) I $L(CODE) D SET("Question Response",$$DATE(CODE))
S CODE=$P(DATA,D,6) I $L(CODE) D SET("Question Response",(CODE*100)_"%")
Q
;
HL ;Display HL Record
S CODE=$P(DATA,D,4)
S LINEVAR=$S(CODE=23:"DEPENDENT INFORMATION",CODE=2:"SUBSCRIBER INFORMATION",1:"")
D SET(LINEVAR,,1,1)
Q
;
LIN ;Drug Identification
S CODE=$P(DATA,D,3) D D SET("Product or Service ID Qualifier",CODE)
. I CODE="EN" S CODE="EAN/UCC-13" Q
. I CODE="EO" S CODE="AND/UCC-8" Q
. I CODE="HI" S CODE="HIBC Supplier Labeling Standard Primary Data Message" Q
. I CODE="N4" S CODE="National Drug Code in 5-4-2 Format" Q
. I CODE="ON" S CODE="Customer Order Number" Q
. I CODE="UK" S CODE="GTIN 14-digit Data Structure" Q
. I CODE="UP" S CODE="UCC-12" Q
. S CODE="UNKNOWN"
D SET("National Drug Code or Universal Product Number",$P(DATA,D,4))
Q
;
LQ ;Form Identification Code
S CODE=$P(DATA,D,2) D D SET("Form Qualifier Code",CODE)
. I CODE="AS" S CODE="Form Type Code" Q
. I CODE="UT" S CODE="CMS DME Certificate of Medical Necessity" Q
D SET("Form Identifier",$P(DATA,D,3))
Q
;
LX ;Service Line Number
D SET("Assigned Number",$P(DATA,D,2))
Q
;
MEA ;Test Results
S CODE=$P(DATA,D,2) D D SET("Measurement Reference ID Code",CODE)
. I CODE="OG" S CODE="Orginal (Starting Dosage)" Q
. I CODE="TR" S CODE="Test Results" Q
. S CODE="UNKNOWN"
S CODE=$P(DATA,D,3) D D SET(CODE,$P(DATA,D,4))
. I CODE="HT" S CODE="Height" Q
. I CODE="R1" S CODE="Hemoglobin" Q
. I CODE="R2" S CODE="Hematocrit" Q
. I CODE="R3" S CODE="Epoetin Starting Dosage" Q
. I CODE="R4" S CODE="Creatinine" Q
. S CODE="UNKNOWN"
Q
;
MOA ;Outpatient Adjudication Information
S CODE=$P(DATA,D,2) I $L(CODE) D SET("Reimbursement Rate",(CODE*100)_"%")
S CODE=$P(DATA,D,3) I $L(CODE) D SET("HCPCS Payable amount",$$DOL(CODE))
S CODE=$P(DATA,D,4) I $L(CODE) D SET("Claim Payment Remark Code",CODE)
S CODE=$P(DATA,D,5) I $L(CODE) D SET(,CODE)
S CODE=$P(DATA,D,6) I $L(CODE) D SET(,CODE)
S CODE=$P(DATA,D,7) I $L(CODE) D SET(,CODE)
S CODE=$P(DATA,D,8) I $L(CODE) D SET(,CODE)
S CODE=$P(DATA,D,9) I $L(CODE) D SET("End Stage Renal Disease Payment Amount",$$DOL(CODE))
S CODE=$P(DATA,D,10) I $L(CODE) D SET("Non-Payable Professional Component Billed Amount",$$DOL(CODE))
Q
;
N3 ;Address line 1
D SET(,$P(DATA,D,2))
I $P(DATA,D,3)'="" D SET(,$P(DATA,D,3))
Q
;
N4 ;City, State, and Zip
D SET(,$P(DATA,D,2)_", "_$P(DATA,D,3)_" "_$$ZIP($P(DATA,D,4)))
Q
;
OI ;Other Insurance Coverage Information
D SET("Benefits Assignment Certification Indicator",$$YN($P(DATA,D,4)))
S CODE=$P(DATA,D,5) I $L(CODE) D SET("Signature Source Code","Signature generated by provider")
S CODE=$P(DATA,D,7) D D SET("Release of Information",CODE)
. I CODE="I" S CODE="Informed Consent to Release Medical Information" Q
. I CODE="Y" S CODE="Yes, Provider has a Signed Statement Permitting Release" Q
Q
;
PAT ;Display Patient Segment
S CODE=$P(DATA,D,2) I CODE'="" D D SET("Relationship to Insured",CODE)
. I CODE="01" S CODE="Spouse" Q
. I CODE=19 S CODE="Child" Q
. I CODE=20 S CODE="Employee" Q
. I CODE=21 S CODE="Unknown" Q
. I CODE=39 S CODE="Organ Donor" Q
. I CODE=40 S CODE="Cadaver Donor" Q
. I CODE=53 S CODE="Life Partner" Q
. I CODE="G8" S CODE="Other Relationship" Q
I $P(DATA,D,7)'="" D SET("Date of Death",$$DATE($P(DATA,D,7)))
I $P(DATA,D,9)'="" D SET("Weight",$P(DATA,D,9)_$S($P(DATA,D,8)="01":" Actual Pounds",1:""))
I $P(DATA,D,10)'="" D SET("Pregnant",$S($P(DATA,D,10)="Y":"Yes",1:"No"))
Q
;
PER ;Submitter EDI Contact Information
N PCE
D SET("Contact",$P(DATA,D,3))
F PCE=4,6,8 D
. I $P(DATA,D,PCE)="EX" D SET(" Extension",$P(DATA,D,PCE+1)) Q
. I $P(DATA,D,PCE)="EM" D SET("Email",$P(DATA,D,PCE+1)) Q
. I $P(DATA,D,PCE)="FX" D SET("Fax",$$PHONE($P(DATA,D,PCE+1)))
. I $P(DATA,D,PCE)="TE" D SET("Phone",$$PHONE($P(DATA,D,PCE+1))) Q
Q
;
PRV ;Provider Specialty
S CODE=$P(DATA,D,2) I $L(CODE) D D SET("Provider Code",CODE)
. I CODE="AS" S CODE="Assistant Surgeon" Q
. I CODE="AT" S CODE="Attending" Q
. I CODE="BI" S CODE="Billing" Q
. I CODE="PE" S CODE="Performing" Q
. I CODE="RF" S CODE="Referring" Q
D SET("Taxonomy Code",$P(DATA,D,4))
Q
;
PS1 ;Purchased Service Information
D SET("Purchased Service Provider ID",$P(DATA,D,2))
D SET("Purchased Service Charge Amount",$$DOL($P(DATA,D,3)))
;
QTY ;Ambulance Patient Count
N ADD,TITLE
S CODE=$P(DATA,D,2) D D SET(TITLE,$P(DATA,D,3)_ADD)
. I CODE="PT" S TITLE="Ambulance Patient Count",ADD="Patient(s)" Q
. I CODE="FL" S TITLE="Obstetric Additional Units",ADD="Unit(s)" Q
. S ADD=""
Q
;
TOO ;Tooth Information
N CNT,TSC
S CODE=$P(DATA,D,2) D D SET("Code List Qualifier",CODE)
. I CODE="JP" S CODE="Universal Tooth Designation System"
D SET("Tooth Code",$P(DATA,D,3))
S CODE=$P(DATA,D,4) F CNT=1:1:5 S TSC=$P(CODE,D1,CNT) I $L(TSC) D D SET($S(CNT=1:"Tooth Surface Code",1:""),TSC)
. I TSC="B" S TSC="Buccal" Q
. I TSC="D" S TSC="Distal" Q
. I TSC="F" S TSC="Facial" Q
. I TSC="I" S TSC="Incisal" Q
. I TSC="L" S TSC="Lingual" Q
. I TSC="M" S TSC="Mesial" Q
. I TSC="O" S TSC="Oclusal"
Q
;
DATE(DATE,TYPE) ;Format Date/Time
N D1
S TYPE=$G(TYPE,"D8")
I TYPE="TM" S D1=DATE G DATEQ
I TYPE="D8"!(TYPE="DT") D G DATEQ
. S D1=$$FMTE^XLFDT($$HL7TFM^XLFDT($E(DATE,1,8)),1)
. I TYPE="DT" S D1=D1_" "_$E(DATE,9,12)
S D1=$$FMTE^XLFDT($$HL7TFM^XLFDT($P(DATE,"-",1),1))_"-"_$$FMTE^XLFDT($$HL7TFM^XLFDT($P(DATE,"-",2),1))
DATEQ ;
Q D1
;
DOL(DATA) ;Format Dollars
S DATA="$"_$FN(DATA,",",2)
Q DATA
;
NAME(DATA) ;Format Person Name
N LAST,FIRST,MI,SUF
S LAST=$P(DATA,D,4),FIRST=$P(DATA,D,5),MI=$P(DATA,D,6),SUF=$P(DATA,D,8)
Q LAST_$S($L(FIRST):", ",1:"")_FIRST_" "_$S($L(MI):MI_" ",1:"")_SUF
;
PHONE(NUM) ;Format phone number
Q "("_$E(NUM,1,3)_") "_$E(NUM,4,6)_"-"_$E(NUM,7,10)
;
YN(YN) ;Translate Yes/No element
Q $S(YN="W":"Not Applicable",YN="U":"Uknown",YN="Y":"Yes",1:"No")
;
ZIP(ZIP) ;Format Zip Code
Q $E(ZIP,1,5)_$S($L(+ZIP>5):"-"_$E(ZIP,6,9),1:"")
;
HELP ; -- help code
;
N X
S X="?" D DISP^XQORM1 W !!
;
Q
;
EXIT ; -- exit code
;
I $G(IBACCWLBILLVELEV)>1 S IBACCWLBILLVELEV=IBACCWLBILLVELEV-1 S VALMQUIT=1 Q ;TPF;IB*2*770v38;EBILL-5485 DO NOT KILL IF CHILD STILL HAS ACTIVE LEVELS
S IBACCWLBILLVELEV=$G(IBACCWLBILLVELEV)-1
D CLEAN^VALM10 ;KILLS DATA AND VIDEO CONTROL ARRAYS. KILLS @VALMAR TOO
;
Q
;
EXPND ; -- expand code
Q
;
SET(TITLE,VALUE,BLANK,HEADER) ;
N COL,T1,WIDTH
;
S TITLE=$G(TITLE),VALUE=$G(VALUE)
Q:TITLE=""&(VALUE="")
;I TITLE'="" B:$G(DUZ)=561&(TITLE="Procedure Code") "S+"
;I TITLE'="",(VALUE'="") B:$G(DUZ)=561&(TITLE="Procedure Code") "S+"
;BEGIN TPF;IB*2*770v53;EBILL-6203
I $G(TITLE)'="",(TITLE="Payer"),(SBR=1) S STOP=1 Q ;THIS TOOK CARE OF NOT DISPLAYING THE COMMUNITY CARE PAYER SECTION
; BECAUSE NO SCENARIO SHOWED IT, SBR = SUBSRIBER LEVEL 2000B LOOP. IS THIS VIABLE?
;
I $G(LASTSECTIONHEAD)'="" Q:$P($G(INCLUDE(LASTSECTIONHEAD)),U,4)[("~"_$P(DATA,D)_"~") ;EXCLUDE SEGMENTS UNDER A CERTAIN SECTION
I $G(LASTSECTIONHEAD)'="",(TITLE'="") Q:$P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,8)[("~"_$P(DATA,D)_"~")
I '$G(BLANK),$G(HEADER),($G(TITLE)'="") Q:'$D(INCLUDE(TITLE))
I $G(HEADER),(TITLE'="") S LASTSECTIONHEAD=TITLE
I LASTSECTIONHEAD'="",(TITLE'="") D
.I $P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,7)'="" X $P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,7) ;TPF;IB*2*770v53;EBILL-6203 ;EXECUTE SPECIAL FIELD FORMAT
;
;END TPF;IB*2*770v53;EBILL-6203
I $G(BLANK) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT," ")
I $G(HEADER) D G SETQ
. I '$D(INCLUDE(LASTSECTIONHEAD)) S STOP=1 Q ;DO NOT DISPLAY ;TPF;IB*2*770v53;EBILL-6203
. I '$L(TITLE) Q
. S VALMCNT=VALMCNT+1
. S COL=((IOM/2)-($L(TITLE)/2))\1
. S WIDTH=$L(TITLE)
. D CNTRL^VALM10(VALMCNT,COL,WIDTH,IORVON,IORVOFF)
. S TITLE=$$SETSTR^VALM1(TITLE,"",COL,WIDTH)
. D SET^VALM10(VALMCNT,TITLE)
;
S LINEVAR=""
I $L(TITLE),'$D(INCLUDE(LASTSECTIONHEAD,TITLE)) Q ;TPF;IB*2*770 ;EBILL-6203
;
I $G(LASTSECTIONHEAD)'="",($G(TITLE)'="") D
.I $P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,5)="$" S VALUE=$P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,5)_$J(VALUE,0,2) ;DOLLAR SYMBOL
.I $P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,4)'="" S TITLE=$P($G(INCLUDE(LASTSECTIONHEAD,TITLE)),U,4) ;FIELD CAPTION OVERRIDE
;
I $L(TITLE)>34 D
. N J,PCE
. S T1=""
. F J=$L(TITLE," "):-1 Q:$L(TITLE)<35 D I $L(TITLE)<35 D SET1(TITLE,"") S TITLE=T1 Q
.. S T1=" "_$P(TITLE," ",J)_T1,TITLE=$P(TITLE," ",1,J-1)
I '$D(INCLUDE(LASTSECTIONHEAD)) Q ;TPF;IB*2*770 ;EBILL-6203
I $L(TITLE) S TITLE=TITLE_":"
D SET1(TITLE,VALUE)
SETQ ;
Q
;
SET1(TITLE,VALUE) ;
S LINEVAR=$$SETFLD^VALM1(TITLE,LINEVAR,"NODE")
S LINEVAR=$$SETFLD^VALM1(VALUE,LINEVAR,"DATA")
S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINEVAR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLBILLVE 16749 printed May 25, 2026@12:09:52 Page 2
IBACCWLBILLVE ;EDE/TAZ - ACC (Automated Community Care) Claims - VIEW ENCOUNTER ; 12-SEP-2023 ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;THIS ROUTINE ALLOWS THE USER TO VIEW THE X12 ENCOUNTER IN READABLE FORMAT.
+5 ;
+6 ;
+7 ;S SESSIONKEY="IBACCBILL",IBENCIFN=56620 D EN^IBACCWLBILLVE
EN ;
+1 NEW D,D1,SBR,VALMAR,VALMCNT,VALMHDR,VALMSG
+2 ;
+3 ;TPF;IB*2*770vPURPLE;EBILL-5385 EE DISPLAYS ONE RECORD
NEW IBPARENT
SET IBPARENT=0
+4 SET IBACCWLBILLVELEV=$GET(IBACCWLBILLVELEV)+1
+5 ;
+6 DO EN^VALM("IBACC WL VE BILLING")
+7 ;
+8 QUIT
+9 ;
HDR ; -- header code
+1 ;
+2 SET VALMHDR(1)="Special Billing View X12 Encounter Data"
+3 ;
+4 QUIT
+5 ;
INIT ;EP -- init variables and list array
+1 NEW CLM,CLMCNT,CODE,D,D1,HI,HL,IOD,LINEVAR,NODE,SBR,TAX
+2 ;TPF;IB*27*70v38;EBILL-5483 Diagnosis Code Pointer ARRAY
NEW DIAGPTRARR,IBFORM
+3 ;TPF;IB*2*770v53;EBILL-6203
NEW DISUSERGROUP,IBTYPEFORM,IBINOUT,USERGROUP
+4 ;
+5 ;CMS-1500, UB-04 OR D
SET IBFORM=$$GET1^DIQ(364.9,IBENCIFN,.06,"E")
+6 ;I OR O
SET IBINOUT=$$GET1^DIQ(364.9,IBENCIFN,.05,"I")
+7 SET IBTYPEFORM="|"_IBINOUT_"_"_$PIECE(IBFORM,"-")_"|"
+8 ;
+9 ;BEGIN TPF;IB*2*770v53;EBILL-6203
+10 SET USERGROUP=$PIECE(SESSIONKEY,"IBACC",2)
+11 SET DISUSERGROUP=$$DISUSERGROUP^IBACCWLBILLVE1A(USERGROUP)
+12 SET VALM("TITLE")=" ACC "_DISUSERGROUP_" View Encounter"
+13 NEW INCLUDE
DO GETINCLUSIONS^IBACCWLBILLVE1A(.INCLUDE,USERGROUP,IBINOUT,IBFORM)
+14 ;
+15 IF '$DATA(INCLUDE)
Begin DoDot:1
+16 WRITE !!,"There are no inclusion parameters set up for"
+17 WRITE !,"Form: ",$GET(IBFORM)
+18 WRITE !,"Pat Type: ",$GET(IBINOUT)
+19 NEW DIR
+20 DO PAUSE^VALM1
+21 SET VALMBCK="Q"
End DoDot:1
QUIT
+22 ;END TPF;IB*2*770v53;EBILL-6203
+23 ;
+24 SET D="*"
SET D1=":"
+25 SET (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0
+26 SET IOD=$$GET1^DIQ(364.9,IBENCIFN,.05,"I")
+27 FOR
SET CLMCNT=$ORDER(^IBA(364.9,IBENCIFN,1,CLMCNT))
if 'CLMCNT
QUIT
SET DATA=^(CLMCNT,0)
if DATA=""
QUIT
Begin DoDot:1
+28 SET NODE=$PIECE(DATA,D,1)
+29 ;Nodes not processed: BHT,CUR,K3,SE,ST
+30 IF ",AMT,CAS,CL1,CLM,CN1,CR1,CR2,CR3,CRC,CTP,DMG,DN1,DN2,DTP,FRM,HCP,HI,HL,LIN,LQ,LX,MEA,MIA,MOA,NM1,NTE,N3,N4,OI,PAT,PER,PRV,PS1,PWK,QTY,REF,SBR,SV1,SV2,SV3,SV5,SVD,TOO,"'[(","_NODE_",")
QUIT
+31 ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
IF ",HI,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLBILLVE1A"
+32 ;I ",CAS,CLM,CRC,DTP,HCP,HI,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE1" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
+33 IF ",CAS,CLM,CRC,DTP,HCP,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLBILLVE1"
+34 IF ",MIA,NM1,PWK,REF,SBR,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLBILLVE2"
+35 ;I ",SV1,SV2,SV3,SV5,SVD,"[(","_NODE_",") S NODE=NODE_"^IBACCWLBILLVE3"
+36 ;TPF;IB*2*770v53;EBILL-6203
IF ",SV1,SV2,SV3,SV5,SVD,NTE,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLBILLVE3"
+37 DO @NODE
End DoDot:1
+38 ;
+39 ;TPF;IB*2*770v53;EBILL-6203
DO SET(""," ")
+40 ;TPF;IB*2*770v53;EBILL-6203
DO SET(""," ")
+41 ;
+42 ;BEGIN TPF*IB*2*770v38;EBILL-5485,5721
+43 IF $GET(IBENCIFN)
IF ($DATA(@VALMAR))
Begin DoDot:1
+44 NEW IBIFN
+45 SET @VALMAR@("IEN3649",1)=IBENCIFN
+46 SET IBIFN=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"I")
+47 if $GET(IBIFN)
SET @VALMAR@("IEN399",1)=IBIFN
End DoDot:1
+48 ;END TPF*IB*2*770v38;EBILL-5485,5721
+49 ;
INITQ ;Exit
+1 IF '$DATA(@VALMAR)
DO SET^VALM10(1,"NO DATA FOUND!!")
+2 QUIT
+3 ;
AMT ;Display Amount Patient Paid
+1 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+2 IF CODE="A8"
SET CODE="Noncovered Charges - Actual"
QUIT
+3 IF CODE="D"
SET CODE="Payor Amount Paid"
QUIT
+4 IF CODE="EAF"
SET CODE="Amount Owed"
QUIT
+5 IF CODE="F3"
SET CODE="Patient Responsibility - Estimated"
QUIT
+6 IF CODE="F4"
SET CODE="Postage Claimed Amount"
QUIT
+7 IF CODE="F5"
SET CODE="Patient Amount Paid"
QUIT
+8 IF CODE="GT"
SET CODE="Service Tax Amount"
QUIT
+9 IF CODE="N8"
SET CODE="Facility Tax Amount"
QUIT
+10 IF CODE="T"
SET CODE="Sales Tax Amount"
QUIT
End DoDot:1
DO SET(CODE,$$DOL($PIECE(DATA,D,3)))
+11 QUIT
+12 ;
CL1 ;Institutional Claim Code
+1 DO SET("Admission Type Code",$PIECE(DATA,D,2))
+2 DO SET("Admission Source Code",$PIECE(DATA,D,3))
+3 DO SET("Patient Status Code",$PIECE(DATA,D,4))
+4 QUIT
+5 ;
CN1 ;Display Contract Information
+1 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+2 IF CODE="01"
SET CODE="Diagnosis Related Group (DRG)"
QUIT
+3 IF CODE="02"
SET CODE="Per Diem"
QUIT
+4 IF CODE="03"
SET CODE="Variable Per Diem"
QUIT
+5 IF CODE="04"
SET CODE="Flat"
QUIT
+6 IF CODE="05"
SET CODE="Capitated"
QUIT
+7 IF CODE="06"
SET CODE="Percent"
QUIT
+8 IF CODE="09"
SET CODE="Other"
QUIT
+9 SET CODE="UNKNOWN CODE"
End DoDot:1
DO SET("Contract Type Code",CODE)
+10 IF $PIECE(DATA,D,3)'=""
DO SET("Contract Amount",$$DOL($PIECE(DATA,D,3)))
+11 IF $PIECE(DATA,D,4)'=""
DO SET("Contract Percentage",($PIECE(DATA,D,4)*100)_"%")
+12 IF $PIECE(DATA,D,5)'=""
DO SET("Contract Code",$PIECE(DATA,D,5))
+13 IF $PIECE(DATA,D,6)'=""
DO SET("Terms Discount Percentage",($PIECE(DATA,D,6)*100)_"%")
+14 IF $PIECE(DATA,D,7)'=""
DO SET("Contract Version Identifier",$PIECE(DATA,D,7))
+15 QUIT
+16 ;
CR1 ;Display Ambulance Transport Information
+1 IF $PIECE(DATA,D,3)'=""
DO SET("Patient Weight",$PIECE(DATA,D,3)_$SELECT($PIECE(DATA,D,2)="LB":" Pounds",1:""))
+2 SET CODE=$PIECE(DATA,D,5)
Begin DoDot:1
+3 IF CODE="A"
SET CODE="Transported to Nearest Facility"
QUIT
+4 IF CODE="B"
SET CODE="Transported for Benefit of Preferred Physician"
QUIT
+5 IF CODE="C"
SET CODE="Transported for Nearness of Family Members"
QUIT
+6 IF CODE="D"
SET CODE="Transported for Care of a Specialist"
QUIT
+7 IF CODE="E"
SET CODE="Transferred to Rehabilitation Facility"
QUIT
+8 SET CODE="UNNKNOWN"
End DoDot:1
DO SET("Ambulance Transport Reason Code",CODE)
+9 DO SET("Transport Distance",$PIECE(DATA,D,7)_$SELECT($PIECE(DATA,D,6)="DH":" Miles",1:""))
+10 IF $PIECE(DATA,D,10)'=""
DO SET("Round Trip Purpose Description",$PIECE(DATA,D,10))
+11 IF $PIECE(DATA,D,11)'=""
DO SET("Stretcher Purpose Description",$PIECE(DATA,D,11))
+12 QUIT
+13 ;
CR2 ;Spinal Manipulation Service Information
+1 SET CODE=$PIECE(DATA,D,9)
Begin DoDot:1
+2 IF CODE="A"
SET CODE="Acute Condition"
QUIT
+3 IF CODE="C"
SET CODE="Chronic Condition"
QUIT
+4 IF CODE="D"
SET CODE="Non-Acute"
QUIT
+5 IF CODE="E"
SET CODE="Non-Life Threatening"
QUIT
+6 IF CODE="F"
SET CODE="Routine"
QUIT
+7 IF CODE="G"
SET CODE="Symptomatic"
QUIT
+8 IF CODE="M"
SET CODE="Acute Manifestation of a Chronic Condition"
QUIT
+9 SET CODE="UNKNOWN"
End DoDot:1
DO SET("Patient Condition",CODE)
+10 IF $PIECE(DATA,D,11)'=""
DO SET("Patient Condition Description",$PIECE(DATA,D,11))
+11 IF $PIECE(DATA,D,12)'=""
DO SET("",$PIECE(DATA,D,12))
+12 QUIT
+13 ;
CR3 ;Durable Medical Equipment Certification
+1 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+2 IF CODE="I"
SET CODE="Initial"
QUIT
+3 IF CODE="R"
SET CODE="Renewal"
QUIT
+4 IF CODE="S"
SET CODE="Revised"
QUIT
+5 SET CODE="UNKNOWN"
End DoDot:1
DO SET("Certification Type Code",CODE)
+6 DO SET("Durable Medical Equipment Duration",$PIECE(DATA,D,4)_$SELECT($PIECE(DATA,D,3)="MO":" Months",1:""))
+7 QUIT
+8 ;
CTP ;Drug Quantity
+1 NEW UNIT
+2 SET UNIT=$PIECE($PIECE(DATA,D,6),D1,1)
Begin DoDot:1
+3 IF UNIT="F2"
SET UNIT=" International Unit(s)"
QUIT
+4 IF UNIT="GR"
SET UNIT=" Gram(s)"
QUIT
+5 IF UNIT="ME"
SET UNIT=" Milligram(s)"
QUIT
+6 IF UNIT="ML"
SET UNIT=" Mililiter(s)"
QUIT
+7 IF UNIT="UN"
SET UNIT=" Unit(s)"
+8 SET UNIT=" "_UNIT
End DoDot:1
DO SET("National Drug Unit Count",$PIECE(DATA,D,5)_UNIT)
+9 QUIT
+10 ;
DMG ;Demographics
+1 DO SET("Date of Birth",$$DATE($PIECE(DATA,D,3)))
+2 DO SET("Gender",$SELECT($PIECE(DATA,D,4)="F":"Female",$PIECE(DATA,D,4)="M":"Male",1:"Unknown"))
+3 IF $PIECE(DATA,D,11)'=""
DO SET("Patient Condition Description",$PIECE(DATA,D,11))
+4 IF $PIECE(DATA,D,12)'=""
DO SET("Patient Condition Description",$PIECE(DATA,D,12))
+5 QUIT
+6 ;
DN1 ;Orthodontic Total Months of Treatment
+1 SET CODE=$PIECE(DATA,D,2)
IF $LENGTH(CODE)
DO SET("Orthodontic Treatment Months Count",CODE)
+2 SET CODE=$PIECE(DATA,D,3)
IF $LENGTH(CODE)
DO SET("Orthodontic Treatment Months Remaining Count",CODE)
+3 SET CODE=$PIECE(DATA,D,5)
IF $LENGTH(CODE)
DO SET("Orthodontic Treatment Indicator",$$YN(CODE))
+4 QUIT
+5 ;
DN2 ;Tooth Status
+1 DO SET("Tooth Number",$PIECE(DATA,D,2))
+2 SET CODE=$PIECE(DATA,D,3)
Begin DoDot:1
+3 IF CODE="E"
SET CODE="To Be Extracted"
+4 IF CODE="M"
SET CODE="Missing"
End DoDot:1
DO SET("Tooth Status",CODE)
+5 SET CODE=$PIECE(DATA,D,7)
Begin DoDot:1
+6 IF CODE="JP"
SET CODE="Universal National Tooth Designation System"
QUIT
End DoDot:1
DO SET("Code List Qualifier Code",CODE)
+7 QUIT
+8 ;
FRM ;Supporting Documentation
+1 DO SET("Question Number/Letter",$PIECE(DATA,D,2))
+2 SET CODE=$PIECE(DATA,D,3)
IF $LENGTH(CODE)
DO SET("Question Response",$$YN(CODE))
+3 SET CODE=$PIECE(DATA,D,4)
IF $LENGTH(CODE)
DO SET("Question Response",CODE)
+4 SET CODE=$PIECE(DATA,D,5)
IF $LENGTH(CODE)
DO SET("Question Response",$$DATE(CODE))
+5 SET CODE=$PIECE(DATA,D,6)
IF $LENGTH(CODE)
DO SET("Question Response",(CODE*100)_"%")
+6 QUIT
+7 ;
HL ;Display HL Record
+1 SET CODE=$PIECE(DATA,D,4)
+2 SET LINEVAR=$SELECT(CODE=23:"DEPENDENT INFORMATION",CODE=2:"SUBSCRIBER INFORMATION",1:"")
+3 DO SET(LINEVAR,,1,1)
+4 QUIT
+5 ;
LIN ;Drug Identification
+1 SET CODE=$PIECE(DATA,D,3)
Begin DoDot:1
+2 IF CODE="EN"
SET CODE="EAN/UCC-13"
QUIT
+3 IF CODE="EO"
SET CODE="AND/UCC-8"
QUIT
+4 IF CODE="HI"
SET CODE="HIBC Supplier Labeling Standard Primary Data Message"
QUIT
+5 IF CODE="N4"
SET CODE="National Drug Code in 5-4-2 Format"
QUIT
+6 IF CODE="ON"
SET CODE="Customer Order Number"
QUIT
+7 IF CODE="UK"
SET CODE="GTIN 14-digit Data Structure"
QUIT
+8 IF CODE="UP"
SET CODE="UCC-12"
QUIT
+9 SET CODE="UNKNOWN"
End DoDot:1
DO SET("Product or Service ID Qualifier",CODE)
+10 DO SET("National Drug Code or Universal Product Number",$PIECE(DATA,D,4))
+11 QUIT
+12 ;
LQ ;Form Identification Code
+1 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+2 IF CODE="AS"
SET CODE="Form Type Code"
QUIT
+3 IF CODE="UT"
SET CODE="CMS DME Certificate of Medical Necessity"
QUIT
End DoDot:1
DO SET("Form Qualifier Code",CODE)
+4 DO SET("Form Identifier",$PIECE(DATA,D,3))
+5 QUIT
+6 ;
LX ;Service Line Number
+1 DO SET("Assigned Number",$PIECE(DATA,D,2))
+2 QUIT
+3 ;
MEA ;Test Results
+1 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+2 IF CODE="OG"
SET CODE="Orginal (Starting Dosage)"
QUIT
+3 IF CODE="TR"
SET CODE="Test Results"
QUIT
+4 SET CODE="UNKNOWN"
End DoDot:1
DO SET("Measurement Reference ID Code",CODE)
+5 SET CODE=$PIECE(DATA,D,3)
Begin DoDot:1
+6 IF CODE="HT"
SET CODE="Height"
QUIT
+7 IF CODE="R1"
SET CODE="Hemoglobin"
QUIT
+8 IF CODE="R2"
SET CODE="Hematocrit"
QUIT
+9 IF CODE="R3"
SET CODE="Epoetin Starting Dosage"
QUIT
+10 IF CODE="R4"
SET CODE="Creatinine"
QUIT
+11 SET CODE="UNKNOWN"
End DoDot:1
DO SET(CODE,$PIECE(DATA,D,4))
+12 QUIT
+13 ;
MOA ;Outpatient Adjudication Information
+1 SET CODE=$PIECE(DATA,D,2)
IF $LENGTH(CODE)
DO SET("Reimbursement Rate",(CODE*100)_"%")
+2 SET CODE=$PIECE(DATA,D,3)
IF $LENGTH(CODE)
DO SET("HCPCS Payable amount",$$DOL(CODE))
+3 SET CODE=$PIECE(DATA,D,4)
IF $LENGTH(CODE)
DO SET("Claim Payment Remark Code",CODE)
+4 SET CODE=$PIECE(DATA,D,5)
IF $LENGTH(CODE)
DO SET(,CODE)
+5 SET CODE=$PIECE(DATA,D,6)
IF $LENGTH(CODE)
DO SET(,CODE)
+6 SET CODE=$PIECE(DATA,D,7)
IF $LENGTH(CODE)
DO SET(,CODE)
+7 SET CODE=$PIECE(DATA,D,8)
IF $LENGTH(CODE)
DO SET(,CODE)
+8 SET CODE=$PIECE(DATA,D,9)
IF $LENGTH(CODE)
DO SET("End Stage Renal Disease Payment Amount",$$DOL(CODE))
+9 SET CODE=$PIECE(DATA,D,10)
IF $LENGTH(CODE)
DO SET("Non-Payable Professional Component Billed Amount",$$DOL(CODE))
+10 QUIT
+11 ;
N3 ;Address line 1
+1 DO SET(,$PIECE(DATA,D,2))
+2 IF $PIECE(DATA,D,3)'=""
DO SET(,$PIECE(DATA,D,3))
+3 QUIT
+4 ;
N4 ;City, State, and Zip
+1 DO SET(,$PIECE(DATA,D,2)_", "_$PIECE(DATA,D,3)_" "_$$ZIP($PIECE(DATA,D,4)))
+2 QUIT
+3 ;
OI ;Other Insurance Coverage Information
+1 DO SET("Benefits Assignment Certification Indicator",$$YN($PIECE(DATA,D,4)))
+2 SET CODE=$PIECE(DATA,D,5)
IF $LENGTH(CODE)
DO SET("Signature Source Code","Signature generated by provider")
+3 SET CODE=$PIECE(DATA,D,7)
Begin DoDot:1
+4 IF CODE="I"
SET CODE="Informed Consent to Release Medical Information"
QUIT
+5 IF CODE="Y"
SET CODE="Yes, Provider has a Signed Statement Permitting Release"
QUIT
End DoDot:1
DO SET("Release of Information",CODE)
+6 QUIT
+7 ;
PAT ;Display Patient Segment
+1 SET CODE=$PIECE(DATA,D,2)
IF CODE'=""
Begin DoDot:1
+2 IF CODE="01"
SET CODE="Spouse"
QUIT
+3 IF CODE=19
SET CODE="Child"
QUIT
+4 IF CODE=20
SET CODE="Employee"
QUIT
+5 IF CODE=21
SET CODE="Unknown"
QUIT
+6 IF CODE=39
SET CODE="Organ Donor"
QUIT
+7 IF CODE=40
SET CODE="Cadaver Donor"
QUIT
+8 IF CODE=53
SET CODE="Life Partner"
QUIT
+9 IF CODE="G8"
SET CODE="Other Relationship"
QUIT
End DoDot:1
DO SET("Relationship to Insured",CODE)
+10 IF $PIECE(DATA,D,7)'=""
DO SET("Date of Death",$$DATE($PIECE(DATA,D,7)))
+11 IF $PIECE(DATA,D,9)'=""
DO SET("Weight",$PIECE(DATA,D,9)_$SELECT($PIECE(DATA,D,8)="01":" Actual Pounds",1:""))
+12 IF $PIECE(DATA,D,10)'=""
DO SET("Pregnant",$SELECT($PIECE(DATA,D,10)="Y":"Yes",1:"No"))
+13 QUIT
+14 ;
PER ;Submitter EDI Contact Information
+1 NEW PCE
+2 DO SET("Contact",$PIECE(DATA,D,3))
+3 FOR PCE=4,6,8
Begin DoDot:1
+4 IF $PIECE(DATA,D,PCE)="EX"
DO SET(" Extension",$PIECE(DATA,D,PCE+1))
QUIT
+5 IF $PIECE(DATA,D,PCE)="EM"
DO SET("Email",$PIECE(DATA,D,PCE+1))
QUIT
+6 IF $PIECE(DATA,D,PCE)="FX"
DO SET("Fax",$$PHONE($PIECE(DATA,D,PCE+1)))
+7 IF $PIECE(DATA,D,PCE)="TE"
DO SET("Phone",$$PHONE($PIECE(DATA,D,PCE+1)))
QUIT
End DoDot:1
+8 QUIT
+9 ;
PRV ;Provider Specialty
+1 SET CODE=$PIECE(DATA,D,2)
IF $LENGTH(CODE)
Begin DoDot:1
+2 IF CODE="AS"
SET CODE="Assistant Surgeon"
QUIT
+3 IF CODE="AT"
SET CODE="Attending"
QUIT
+4 IF CODE="BI"
SET CODE="Billing"
QUIT
+5 IF CODE="PE"
SET CODE="Performing"
QUIT
+6 IF CODE="RF"
SET CODE="Referring"
QUIT
End DoDot:1
DO SET("Provider Code",CODE)
+7 DO SET("Taxonomy Code",$PIECE(DATA,D,4))
+8 QUIT
+9 ;
PS1 ;Purchased Service Information
+1 DO SET("Purchased Service Provider ID",$PIECE(DATA,D,2))
+2 DO SET("Purchased Service Charge Amount",$$DOL($PIECE(DATA,D,3)))
+3 ;
QTY ;Ambulance Patient Count
+1 NEW ADD,TITLE
+2 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+3 IF CODE="PT"
SET TITLE="Ambulance Patient Count"
SET ADD="Patient(s)"
QUIT
+4 IF CODE="FL"
SET TITLE="Obstetric Additional Units"
SET ADD="Unit(s)"
QUIT
+5 SET ADD=""
End DoDot:1
DO SET(TITLE,$PIECE(DATA,D,3)_ADD)
+6 QUIT
+7 ;
TOO ;Tooth Information
+1 NEW CNT,TSC
+2 SET CODE=$PIECE(DATA,D,2)
Begin DoDot:1
+3 IF CODE="JP"
SET CODE="Universal Tooth Designation System"
End DoDot:1
DO SET("Code List Qualifier",CODE)
+4 DO SET("Tooth Code",$PIECE(DATA,D,3))
+5 SET CODE=$PIECE(DATA,D,4)
FOR CNT=1:1:5
SET TSC=$PIECE(CODE,D1,CNT)
IF $LENGTH(TSC)
Begin DoDot:1
+6 IF TSC="B"
SET TSC="Buccal"
QUIT
+7 IF TSC="D"
SET TSC="Distal"
QUIT
+8 IF TSC="F"
SET TSC="Facial"
QUIT
+9 IF TSC="I"
SET TSC="Incisal"
QUIT
+10 IF TSC="L"
SET TSC="Lingual"
QUIT
+11 IF TSC="M"
SET TSC="Mesial"
QUIT
+12 IF TSC="O"
SET TSC="Oclusal"
End DoDot:1
DO SET($SELECT(CNT=1:"Tooth Surface Code",1:""),TSC)
+13 QUIT
+14 ;
DATE(DATE,TYPE) ;Format Date/Time
+1 NEW D1
+2 SET TYPE=$GET(TYPE,"D8")
+3 IF TYPE="TM"
SET D1=DATE
GOTO DATEQ
+4 IF TYPE="D8"!(TYPE="DT")
Begin DoDot:1
+5 SET D1=$$FMTE^XLFDT($$HL7TFM^XLFDT($EXTRACT(DATE,1,8)),1)
+6 IF TYPE="DT"
SET D1=D1_" "_$EXTRACT(DATE,9,12)
End DoDot:1
GOTO DATEQ
+7 SET D1=$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(DATE,"-",1),1))_"-"_$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(DATE,"-",2),1))
DATEQ ;
+1 QUIT D1
+2 ;
DOL(DATA) ;Format Dollars
+1 SET DATA="$"_$FNUMBER(DATA,",",2)
+2 QUIT DATA
+3 ;
NAME(DATA) ;Format Person Name
+1 NEW LAST,FIRST,MI,SUF
+2 SET LAST=$PIECE(DATA,D,4)
SET FIRST=$PIECE(DATA,D,5)
SET MI=$PIECE(DATA,D,6)
SET SUF=$PIECE(DATA,D,8)
+3 QUIT LAST_$SELECT($LENGTH(FIRST):", ",1:"")_FIRST_" "_$SELECT($LENGTH(MI):MI_" ",1:"")_SUF
+4 ;
PHONE(NUM) ;Format phone number
+1 QUIT "("_$EXTRACT(NUM,1,3)_") "_$EXTRACT(NUM,4,6)_"-"_$EXTRACT(NUM,7,10)
+2 ;
YN(YN) ;Translate Yes/No element
+1 QUIT $SELECT(YN="W":"Not Applicable",YN="U":"Uknown",YN="Y":"Yes",1:"No")
+2 ;
ZIP(ZIP) ;Format Zip Code
+1 QUIT $EXTRACT(ZIP,1,5)_$SELECT($LENGTH(+ZIP>5):"-"_$EXTRACT(ZIP,6,9),1:"")
+2 ;
HELP ; -- help code
+1 ;
+2 NEW X
+3 SET X="?"
DO DISP^XQORM1
WRITE !!
+4 ;
+5 QUIT
+6 ;
EXIT ; -- exit code
+1 ;
+2 ;TPF;IB*2*770v38;EBILL-5485 DO NOT KILL IF CHILD STILL HAS ACTIVE LEVELS
IF $GET(IBACCWLBILLVELEV)>1
SET IBACCWLBILLVELEV=IBACCWLBILLVELEV-1
SET VALMQUIT=1
QUIT
+3 SET IBACCWLBILLVELEV=$GET(IBACCWLBILLVELEV)-1
+4 ;KILLS DATA AND VIDEO CONTROL ARRAYS. KILLS @VALMAR TOO
DO CLEAN^VALM10
+5 ;
+6 QUIT
+7 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SET(TITLE,VALUE,BLANK,HEADER) ;
+1 NEW COL,T1,WIDTH
+2 ;
+3 SET TITLE=$GET(TITLE)
SET VALUE=$GET(VALUE)
+4 if TITLE=""&(VALUE="")
QUIT
+5 ;I TITLE'="" B:$G(DUZ)=561&(TITLE="Procedure Code") "S+"
+6 ;I TITLE'="",(VALUE'="") B:$G(DUZ)=561&(TITLE="Procedure Code") "S+"
+7 ;BEGIN TPF;IB*2*770v53;EBILL-6203
+8 ;THIS TOOK CARE OF NOT DISPLAYING THE COMMUNITY CARE PAYER SECTION
IF $GET(TITLE)'=""
IF (TITLE="Payer")
IF (SBR=1)
SET STOP=1
QUIT
+9 ; BECAUSE NO SCENARIO SHOWED IT, SBR = SUBSRIBER LEVEL 2000B LOOP. IS THIS VIABLE?
+10 ;
+11 ;EXCLUDE SEGMENTS UNDER A CERTAIN SECTION
IF $GET(LASTSECTIONHEAD)'=""
if $PIECE($GET(INCLUDE(LASTSECTIONHEAD)),U,4)[("~"_$PIECE(DATA,D)_"~")
QUIT
+12 IF $GET(LASTSECTIONHEAD)'=""
IF (TITLE'="")
if $PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,8)[("~"_$PIECE(DATA,D)_"~")
QUIT
+13 IF '$GET(BLANK)
IF $GET(HEADER)
IF ($GET(TITLE)'="")
if '$DATA(INCLUDE(TITLE))
QUIT
+14 IF $GET(HEADER)
IF (TITLE'="")
SET LASTSECTIONHEAD=TITLE
+15 IF LASTSECTIONHEAD'=""
IF (TITLE'="")
Begin DoDot:1
+16 ;TPF;IB*2*770v53;EBILL-6203 ;EXECUTE SPECIAL FIELD FORMAT
IF $PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,7)'=""
XECUTE $PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,7)
End DoDot:1
+17 ;
+18 ;END TPF;IB*2*770v53;EBILL-6203
+19 IF $GET(BLANK)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT," ")
+20 IF $GET(HEADER)
Begin DoDot:1
+21 ;DO NOT DISPLAY ;TPF;IB*2*770v53;EBILL-6203
IF '$DATA(INCLUDE(LASTSECTIONHEAD))
SET STOP=1
QUIT
+22 IF '$LENGTH(TITLE)
QUIT
+23 SET VALMCNT=VALMCNT+1
+24 SET COL=((IOM/2)-($LENGTH(TITLE)/2))\1
+25 SET WIDTH=$LENGTH(TITLE)
+26 DO CNTRL^VALM10(VALMCNT,COL,WIDTH,IORVON,IORVOFF)
+27 SET TITLE=$$SETSTR^VALM1(TITLE,"",COL,WIDTH)
+28 DO SET^VALM10(VALMCNT,TITLE)
End DoDot:1
GOTO SETQ
+29 ;
+30 SET LINEVAR=""
+31 ;TPF;IB*2*770 ;EBILL-6203
IF $LENGTH(TITLE)
IF '$DATA(INCLUDE(LASTSECTIONHEAD,TITLE))
QUIT
+32 ;
+33 IF $GET(LASTSECTIONHEAD)'=""
IF ($GET(TITLE)'="")
Begin DoDot:1
+34 ;DOLLAR SYMBOL
IF $PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,5)="$"
SET VALUE=$PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,5)_$JUSTIFY(VALUE,0,2)
+35 ;FIELD CAPTION OVERRIDE
IF $PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,4)'=""
SET TITLE=$PIECE($GET(INCLUDE(LASTSECTIONHEAD,TITLE)),U,4)
End DoDot:1
+36 ;
+37 IF $LENGTH(TITLE)>34
Begin DoDot:1
+38 NEW J,PCE
+39 SET T1=""
+40 FOR J=$LENGTH(TITLE," "):-1
if $LENGTH(TITLE)<35
QUIT
Begin DoDot:2
+41 SET T1=" "_$PIECE(TITLE," ",J)_T1
SET TITLE=$PIECE(TITLE," ",1,J-1)
End DoDot:2
IF $LENGTH(TITLE)<35
DO SET1(TITLE,"")
SET TITLE=T1
QUIT
End DoDot:1
+42 ;TPF;IB*2*770 ;EBILL-6203
IF '$DATA(INCLUDE(LASTSECTIONHEAD))
QUIT
+43 IF $LENGTH(TITLE)
SET TITLE=TITLE_":"
+44 DO SET1(TITLE,VALUE)
SETQ ;
+1 QUIT
+2 ;
SET1(TITLE,VALUE) ;
+1 SET LINEVAR=$$SETFLD^VALM1(TITLE,LINEVAR,"NODE")
+2 SET LINEVAR=$$SETFLD^VALM1(VALUE,LINEVAR,"DATA")
+3 SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINEVAR)
+4 QUIT
