IBACCWLVE ;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.
;
;
;D EN^IBACCWL
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 IBACCWLVELEV=$G(IBACCWLVELEV)+1
;
D EN^VALM("IBACC WL VE")
Q
;
HDR ; -- header code
;
S VALMHDR(1)="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
S IBFORM=$$GET1^DIQ(364.9,IBENCIFN,.06,"E") ;CMS-1500 OR UB-04
S D="*",D1=":"
;S (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0 ;;TPF;IB*2*770v51;EBILL-6178
;INDICATES COMING IN FROM IBACCWLPREV
I '$G(VALMCNT) S (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0 ;TPF;IB*2*770v51;EBILL-6178 ;
E D
.S (CLM,CLMCNT,HI,HL,SBR)=0
.D SET("","",1,0)
.D SET("ACC View Encounter Data","",0,1) ;TPF;IB*2*770v51;EBILL-3829
.D SET("","",1,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_"^IBACCWLVE1A" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
. ;I ",CAS,CLM,CRC,DTP,HCP,HI,"[(","_NODE_",") S NODE=NODE_"^IBACCWLVE1" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
. I ",CAS,CLM,CRC,DTP,HCP,"[(","_NODE_",") S NODE=NODE_"^IBACCWLVE1"
. I ",MIA,NM1,PWK,REF,SBR,"[(","_NODE_",") S NODE=NODE_"^IBACCWLVE2"
. I ",SV1,SV2,SV3,SV5,SVD,"[(","_NODE_",") S NODE=NODE_"^IBACCWLVE3"
. D @NODE
;
;BEGIN TPF*IB*2*770v38;EBILL-5485,5721
I $G(IBENCIFN),($D(@VALMAR)) D
.N IBIFN ;WCJ;V41
.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
;
NTE ;Display Claim Note
S CODE=$P(DATA,D,2) I CODE'="" D D SET(CODE,$P(DATA,D,3))
. I CODE="ADD" S CODE="Additional Information" Q
. I CODE="ALG" S CODE="Allergies" Q
. I CODE="CER" S CODE="Certification Narrative" Q
. I CODE="DCP" S CODE="Goals, Rehabilitation Potential, or Discharge Plans" Q
. I CODE="DGN" S CODE="Diagnosis Description" Q
. I CODE="DME" S CODE="Durable Medical Equipment (DME) and Supplies" Q
. I CODE="MED" S CODE="Medications" Q
. I CODE="NTR" S CODE="Nutritional Requirements" Q
. I CODE="ODT" S CODE="Orders for Disciplines and Treatments" Q
. I CODE="RHB" S CODE="Functional Limitations, Reason Homebound, or Both" Q
. I CODE="RLH" S CODE="Reason Patient Leaves Home" Q
. I CODE="RNH" S CODE="Times and Reasons Patient Not at Home" Q
. I CODE="SET" S CODE="Unusual Home, Social Environment, or Both" Q
. I CODE="SFM" S CODE="Safety Measures" Q
. I CODE="SPT" S CODE="Supplementary Plan of Treatment" Q
. I CODE="TPO" S CODE="Third Party Organization Notes" Q
. I CODE="UPI" S CODE="Updated Information" Q
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(IBACCWLVELEV)>1 S IBACCWLVELEV=IBACCWLVELEV-1 S VALMQUIT=1 Q ;TPF;IB*2*770v38;EBILL-5485 DO NOT KILL IF CHILD STILL HAS ACTIVE LEVELS
;S IBACCWLVELEV=IBACCWLVELEV-1
S IBACCWLVELEV=$G(IBACCWLVELEV)-1 ;TPF;IB*2*770v44;EBILL-6011
D CLEAN^VALM10 ;KILLS DATA AND VIDEO CONTROL ARRAYS. KILLS @VALMAR TOO
K ^TMP("IBACCWLVE",$J,"BP NPI")
Q
;
EXPND ; -- expand code
Q
;
SET(TITLE,VALUE,BLANK,HEADER) ;
N COL,T1,WIDTH
S TITLE=$G(TITLE),VALUE=$G(VALUE)
I $G(BLANK) S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT," ")
I $G(HEADER) D G SETQ
. 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)>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 $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[HIBACCWLVE 15622 printed May 25, 2026@12:10:19 Page 2
IBACCWLVE ;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 ;D EN^IBACCWL
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 IBACCWLVELEV=$GET(IBACCWLVELEV)+1
+5 ;
+6 DO EN^VALM("IBACC WL VE")
+7 QUIT
+8 ;
HDR ; -- header code
+1 ;
+2 SET VALMHDR(1)="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 ;CMS-1500 OR UB-04
SET IBFORM=$$GET1^DIQ(364.9,IBENCIFN,.06,"E")
+4 SET D="*"
SET D1=":"
+5 ;S (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0 ;;TPF;IB*2*770v51;EBILL-6178
+6 ;INDICATES COMING IN FROM IBACCWLPREV
+7 ;TPF;IB*2*770v51;EBILL-6178 ;
IF '$GET(VALMCNT)
SET (CLM,CLMCNT,HI,HL,SBR,VALMCNT)=0
+8 IF '$TEST
Begin DoDot:1
+9 SET (CLM,CLMCNT,HI,HL,SBR)=0
+10 DO SET("","",1,0)
+11 ;TPF;IB*2*770v51;EBILL-3829
DO SET("ACC View Encounter Data","",0,1)
+12 DO SET("","",1,0)
End DoDot:1
+13 ;
+14 SET IOD=$$GET1^DIQ(364.9,IBENCIFN,.05,"I")
+15 FOR
SET CLMCNT=$ORDER(^IBA(364.9,IBENCIFN,1,CLMCNT))
if 'CLMCNT
QUIT
SET DATA=^(CLMCNT,0)
if DATA=""
QUIT
Begin DoDot:1
+16 SET NODE=$PIECE(DATA,D,1)
+17 ;Nodes not processed: BHT,CUR,K3,SE,ST
+18 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
+19 ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
IF ",HI,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLVE1A"
+20 ;I ",CAS,CLM,CRC,DTP,HCP,HI,"[(","_NODE_",") S NODE=NODE_"^IBACCWLVE1" ;TPF;IB*2*770v770PURPLE;EBILL-9999 SAC SIZE
+21 IF ",CAS,CLM,CRC,DTP,HCP,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLVE1"
+22 IF ",MIA,NM1,PWK,REF,SBR,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLVE2"
+23 IF ",SV1,SV2,SV3,SV5,SVD,"[(","_NODE_",")
SET NODE=NODE_"^IBACCWLVE3"
+24 DO @NODE
End DoDot:1
+25 ;
+26 ;BEGIN TPF*IB*2*770v38;EBILL-5485,5721
+27 IF $GET(IBENCIFN)
IF ($DATA(@VALMAR))
Begin DoDot:1
+28 ;WCJ;V41
NEW IBIFN
+29 SET @VALMAR@("IEN3649",1)=IBENCIFN
+30 SET IBIFN=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"I")
+31 if $GET(IBIFN)
SET @VALMAR@("IEN399",1)=IBIFN
End DoDot:1
+32 ;END TPF*IB*2*770v38;EBILL-5485,5721
+33 ;
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 ;
NTE ;Display Claim Note
+1 SET CODE=$PIECE(DATA,D,2)
IF CODE'=""
Begin DoDot:1
+2 IF CODE="ADD"
SET CODE="Additional Information"
QUIT
+3 IF CODE="ALG"
SET CODE="Allergies"
QUIT
+4 IF CODE="CER"
SET CODE="Certification Narrative"
QUIT
+5 IF CODE="DCP"
SET CODE="Goals, Rehabilitation Potential, or Discharge Plans"
QUIT
+6 IF CODE="DGN"
SET CODE="Diagnosis Description"
QUIT
+7 IF CODE="DME"
SET CODE="Durable Medical Equipment (DME) and Supplies"
QUIT
+8 IF CODE="MED"
SET CODE="Medications"
QUIT
+9 IF CODE="NTR"
SET CODE="Nutritional Requirements"
QUIT
+10 IF CODE="ODT"
SET CODE="Orders for Disciplines and Treatments"
QUIT
+11 IF CODE="RHB"
SET CODE="Functional Limitations, Reason Homebound, or Both"
QUIT
+12 IF CODE="RLH"
SET CODE="Reason Patient Leaves Home"
QUIT
+13 IF CODE="RNH"
SET CODE="Times and Reasons Patient Not at Home"
QUIT
+14 IF CODE="SET"
SET CODE="Unusual Home, Social Environment, or Both"
QUIT
+15 IF CODE="SFM"
SET CODE="Safety Measures"
QUIT
+16 IF CODE="SPT"
SET CODE="Supplementary Plan of Treatment"
QUIT
+17 IF CODE="TPO"
SET CODE="Third Party Organization Notes"
QUIT
+18 IF CODE="UPI"
SET CODE="Updated Information"
QUIT
End DoDot:1
DO SET(CODE,$PIECE(DATA,D,3))
+19 QUIT
+20 ;
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(IBACCWLVELEV)>1
SET IBACCWLVELEV=IBACCWLVELEV-1
SET VALMQUIT=1
QUIT
+3 ;S IBACCWLVELEV=IBACCWLVELEV-1
+4 ;TPF;IB*2*770v44;EBILL-6011
SET IBACCWLVELEV=$GET(IBACCWLVELEV)-1
+5 ;KILLS DATA AND VIDEO CONTROL ARRAYS. KILLS @VALMAR TOO
DO CLEAN^VALM10
+6 KILL ^TMP("IBACCWLVE",$JOB,"BP NPI")
+7 QUIT
+8 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SET(TITLE,VALUE,BLANK,HEADER) ;
+1 NEW COL,T1,WIDTH
+2 SET TITLE=$GET(TITLE)
SET VALUE=$GET(VALUE)
+3 IF $GET(BLANK)
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT," ")
+4 IF $GET(HEADER)
Begin DoDot:1
+5 IF '$LENGTH(TITLE)
QUIT
+6 SET VALMCNT=VALMCNT+1
+7 SET COL=((IOM/2)-($LENGTH(TITLE)/2))\1
+8 SET WIDTH=$LENGTH(TITLE)
+9 DO CNTRL^VALM10(VALMCNT,COL,WIDTH,IORVON,IORVOFF)
+10 SET TITLE=$$SETSTR^VALM1(TITLE,"",COL,WIDTH)
+11 DO SET^VALM10(VALMCNT,TITLE)
End DoDot:1
GOTO SETQ
+12 SET LINEVAR=""
+13 IF $LENGTH(TITLE)>34
Begin DoDot:1
+14 NEW J,PCE
+15 SET T1=""
+16 FOR J=$LENGTH(TITLE," "):-1
if $LENGTH(TITLE)<35
QUIT
Begin DoDot:2
+17 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
+18 IF $LENGTH(TITLE)
SET TITLE=TITLE_":"
+19 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
