IBCNFRD2 ;WOIFO/KJS - Electronic Insurance Identification ;25-MAY-2011
;;2.0;INTEGRATED BILLING;**457**;21-MAR-94;Build 30
;;Per VHA Directive 2004-038, this routine should not be modified.
;;
;
; Electronic Insurance Indentification Sending and Receiving AITC messages
;
Q
;
BLDXML ;
;now create the XML file
N XMLFILE,XMLHEAD,XMLCOL,SEQ,REC,HMSDIR,XMLX,DQUOTE,SQUOTE,AMP,GT,LT,SITE
D INITXML
D OPEN^%ZISH("XMLFILE",HMSDIR,XMLFILE,"W")
Q:POP
U IO
D XMLSTART
S SEQ=0
F S SEQ=$O(XMLCOL(SEQ)) Q:SEQ="" D XMLCOL($P(XMLCOL(SEQ),U,2))
W !,"<Row>"
F S SEQ=$O(XMLCOL(SEQ)) Q:SEQ="" D XMLCELL($P(XMLCOL(SEQ),U,5),"String",$P(XMLCOL(SEQ),U,6))
W !,"</Row>"
S MSGID=0,IBCNT=0
F S MSGID=$O(^XTMP("IBCNFRD",MSGID)) Q:'MSGID D
. S IBREC=0
. F S IBREC=$O(^XTMP("IBCNFRD",MSGID,IBREC)) Q:'IBREC D
.. S IBCNT=IBCNT+1
.. W !,"<Row>"
.. S REC=^XTMP("IBCNFRD",MSGID,IBREC)
.. S SEQ=0
.. F S SEQ=$O(XMLCOL(SEQ)) Q:SEQ="" D
... N DATA,POS,SUB,DSUB
... S POS=$P(XMLCOL(SEQ),U)
... S DATA=$P(REC,U,+POS)
... I POS["@" S SUB=$P(POS,"@",2) S DSUB=SUB_"(.DATA)" D @DSUB
... D XMLCELL(DATA,$P(XMLCOL(SEQ),U,3),$P(XMLCOL(SEQ),U,4))
.. W !,"</Row>"
D XMLEND
D CLOSE^%ZISH("XMLFILE")
;
; Send Email to IBCNF EII XML READY that Result file is ready
N XMSUB,IBXMLMSG,XMY,XMTEXT,IBNOW,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
S XMSUB="HMS result XML file "_HMSDIR_XMLFILE_" is ready"
S IBXMLMSG(1)="HMS result XML file "_HMSDIR_XMLFILE_" is ready to be retrieved"
S XMTEXT="IBXMLMSG("
S XMY("G.IBCNF EII XML READY")=""
D ^XMD
Q
;
POLDET(DATA) ;policy determination
S DATA=$S(DATA="00/00/0000":"POLICY NOT FOUND",DATA="12/31/9999":"ACTIVE",1:"INACTIVE")
Q
;
XMLCOL(WIDTH) ;
W !,"<Column ss:StyleID=""s8"" ss:Width=""",WIDTH,"""/>"
Q
;
XMLCELL(DATA,TYPE,STYLE) ;
I TYPE="DateTime" D
.;check for valid date and if it is valid format it in excel format
.;otherwise, set the cell to a string type and use the original format
.N %DT,X,Y,YR,MN,DA
.S X=DATA
.D ^%DT
.I Y=-1 S TYPE="String" Q
.S YR=$P(DATA,"/",3),MN=$P(DATA,"/"),DA=$P(DATA,"/",2)
.;excel dates are invalid before 1/1/1900
.I YR<1900 S TYPE="String" Q
.S DATA=YR_"-"_MN_"-"_DA
;
W !,"<Cell ss:StyleID=""",STYLE,"""><Data ss:Type=""",TYPE,""">",$$XML(DATA),"</Data></Cell>"
Q
;
XML(DATA) ;
N DATA2
;excel 2007 doesn't like escaped xml chars even though documentation says otherwise
;but CDATA syntax does work
;
S DATA2="<![CDATA["_DATA_"]]>"
Q DATA2
;
XMLSTART ;
W "<?xml version=""1.0""?>"
W !,"<?mso-application progid=""Excel.Sheet""?>"
W !,"<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"""
W !,"xmlns:o=""urn:schemas-microsoft-com:office:office"""
W !,"xmlns:x=""urn:schemas-microsoft-com:office:excel"""
W !,"xmlns:ss=""urn:schemas-microsoft-com:office:spreadsheet"""
W !,"xmlns:html=""http://www.w3.org/TR/REC-html40"">"
W !,"<Styles>"
W !,"<Style ss:ID=""Default"" ss:Name=""Normal"">"
W !,"<Alignment ss:Vertical=""Bottom""/>"
W !,"<Borders/>"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Color=""#000000""/>"
W !,"<Interior/>"
W !,"<NumberFormat/>"
W !,"<Protection/>"
W !,"</Style>"
W !,"<Style ss:ID=""s1"">"
W !,"<NumberFormat ss:Format=""Short Date""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s2"">"
W !,"<NumberFormat/>"
W !,"</Style>"
W !,"<Style ss:ID=""s3"">"
W !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
W !,"<Borders>"
W !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"</Borders>"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8""/>"
W !,"<NumberFormat ss:Format=""Short Date""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s4"">"
W !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
W !,"<Borders>"
W !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"</Borders>"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8""/>"
W !,"<NumberFormat ss:Format=""@""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s5"">"
W !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s6"">"
W !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
W !,"<Borders>"
W !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"</Borders>"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#FFFFFF"" ss:Bold=""1""/>"
W !,"<Interior ss:Color=""#000000"" ss:Pattern=""Solid""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s7"">"
W !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
W !,"<Borders>"
W !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
W !,"</Borders>"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#FFFF00"" ss:Bold=""1""/>"
W !,"<Interior ss:Color=""#000000"" ss:Pattern=""Solid""/>"
W !,"</Style>"
W !,"<Style ss:ID=""s8"">"
W !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#000000""/>"
W !,"</Style>"
W !,"</Styles>"
W !,"<Worksheet ss:Name=""",$P(XMLFILE,"."),""">"
W !,"<Table x:FullColumns=""1"" x:FullRows=""1"" ss:DefaultRowHeight=""11.25"">"
Q
;
XMLEND ;
W !,"</Table>"
W !,"<WorksheetOptions xmlns=""urn:schemas-microsoft-com:office:excel"">"
W !,"<PageSetup>"
W !,"<Header x:Data=""&L&D&R&"Arial,Bold"&8HMS Insurance Identification Results""/>"
W !,"<Footer x:Data=""&F&RPage &P""/>"
W !,"</PageSetup>"
W !,"<FreezePanes/>"
W !,"<FrozenNoSplit/>"
W !,"<SplitHorizontal>1</SplitHorizontal>"
W !,"<TopRowBottomPane>1</TopRowBottomPane>"
W !,"</WorksheetOptions>"
W !,"</Worksheet>"
W !,"</Workbook>"
Q
;
INITXML ;
;XMLCOL(N)=P^W^T^SC^H^SH
;N=column number in spreadsheet
;P=piece number from result file record
;W=width of column
;T=cell type
;SC=cell style
;H=HEADER
;SH=header style
;
N COL
S COL=0
S COL=COL+1,XMLCOL(COL)="1^57^String^s4^Autonumber^s6"
S COL=COL+1,XMLCOL(COL)="2^96^String^s4^Patient Name^s6"
S COL=COL+1,XMLCOL(COL)="3^51.75^String^s4^Patient SSN^s6"
S COL=COL+1,XMLCOL(COL)="4^52.5^DateTime^s3^Patient DOB^s6"
S COL=COL+1,XMLCOL(COL)="5^52.5^String^s4^Patient Age^s6"
S COL=COL+1,XMLCOL(COL)="70^87^String^s4^Pt. Rel. to Insured ID^s6"
S COL=COL+1,XMLCOL(COL)="71^69^String^s4^Pat. ID^s6"
S COL=COL+1,XMLCOL(COL)="6^186.75^String^s4^Carrier Name^s6"
S COL=COL+1,XMLCOL(COL)="7^63^String^s4^Carrier Phone^s6"
S COL=COL+1,XMLCOL(COL)="8^60.75^DateTime^s3^Effective Date^s6"
S COL=COL+1,XMLCOL(COL)="9^75^String^s4^Insurance Active^s6"
S COL=COL+1,XMLCOL(COL)="10^45.75^DateTime^s3^Thru Date^s6"
S COL=COL+1,XMLCOL(COL)="11^80.25^String^s4^Group ID^s6"
S COL=COL+1,XMLCOL(COL)="12^108^String^s4^Group Name^s6"
S COL=COL+1,XMLCOL(COL)="13^105^String^s4^Carrier Address 1^s6"
S COL=COL+1,XMLCOL(COL)="14^99.75^String^s4^Carrier Address 2^s6"
S COL=COL+1,XMLCOL(COL)="15^75^String^s4^Carrier City^s6"
S COL=COL+1,XMLCOL(COL)="16^57.75^String^s4^Carrier State^s6"
S COL=COL+1,XMLCOL(COL)="17^49.5^String^s4^Carrier Zip^s6"
S COL=COL+1,XMLCOL(COL)="18^105^String^s4^Out Patient Address 1^s6"
S COL=COL+1,XMLCOL(COL)="19^99.75^String^s4^Out Patient Address 2^s6"
S COL=COL+1,XMLCOL(COL)="20^75^String^s4^Out Patient City^s6"
S COL=COL+1,XMLCOL(COL)="21^74.25^String^s4^Out Patient State^s6"
S COL=COL+1,XMLCOL(COL)="22^65.25^String^s4^Out Patient Zip^s6"
S COL=COL+1,XMLCOL(COL)="23^113.25^String^s4^Policy Holder Name^s6"
S COL=COL+1,XMLCOL(COL)="24^48.75^DateTime^s3^Policy DOB^s6"
S COL=COL+1,XMLCOL(COL)="25^69^String^s4^Policy Holder ID^s6"
S COL=COL+1,XMLCOL(COL)="26^50.25^String^s4^Filing Limit^s6"
S COL=COL+1,XMLCOL(COL)="65^96^String^s4^Coverage Type^s6"
S COL=COL+1,XMLCOL(COL)="38^43.5^String^s4^Medicare^s6"
S COL=COL+1,XMLCOL(COL)="39^30^String^s4^Part A^s6"
S COL=COL+1,XMLCOL(COL)="40^29.25^String^s4^Part B^s6"
S COL=COL+1,XMLCOL(COL)="41^53.25^String^s4^MC Primary^s6"
S COL=COL+1,XMLCOL(COL)="42^77.25^DateTime^s3^MC Effective Date^s6"
S COL=COL+1,XMLCOL(COL)="43^64.5^String^s4^MC Secondary^s6"
S COL=COL+1,XMLCOL(COL)="44^66.75^String^s4^Medicare Supp^s6"
S COL=COL+1,XMLCOL(COL)="45^38.25^String^s4^MC Plan^s6"
S COL=COL+1,XMLCOL(COL)="46^61.5^String^s4^MC Carve Out^s6"
S COL=COL+1,XMLCOL(COL)="47^39.75^String^s4^MC HMO^s6"
S COL=COL+1,XMLCOL(COL)="48^57.75^String^s4^RX Coverage^s6"
S COL=COL+1,XMLCOL(COL)="50^151.5^String^s4^RX Name^s6"
S COL=COL+1,XMLCOL(COL)="51^120.75^String^s4^RX Address^s6"
S COL=COL+1,XMLCOL(COL)="52^61.5^String^s4^RX City^s6"
S COL=COL+1,XMLCOL(COL)="53^39^String^s4^RX State^s6"
S COL=COL+1,XMLCOL(COL)="54^30.75^String^s4^RX Zip^s6"
S COL=COL+1,XMLCOL(COL)="55^72.75^String^s4^Pre Certification^s6"
S COL=COL+1,XMLCOL(COL)="56^69^String^s4^Pre Cert Phone^s6"
S COL=COL+1,XMLCOL(COL)="57^83.25^String^s4^Pre Cert Contact^s6"
S COL=COL+1,XMLCOL(COL)="58^45.75^String^s4^Bill Phone^s6"
S COL=COL+1,XMLCOL(COL)="59^73.5^DateTime^s3^Verification Date^s6"
S COL=COL+1,XMLCOL(COL)="60^83.25^String^s4^Verified By^s6"
S COL=COL+1,XMLCOL(COL)="61^96.75^String^s4^Verification Complete^s6"
S COL=COL+1,XMLCOL(COL)="62^40.5^String^s4^File ID^s6"
S COL=COL+1,XMLCOL(COL)="67^53.25^String^s4^Bin Number^s6"
S COL=COL+1,XMLCOL(COL)="68^57^String^s4^PCN Number^s6"
S COL=COL+1,XMLCOL(COL)="69^50.25^String^s4^RX Phone^s6"
S COL=COL+1,XMLCOL(COL)="10@POLDET^91.5^String^s4^Policy Determination^s6"
S COL=COL+1,XMLCOL(COL)="73^51.75^String^s4^Terminator^s6"
S SITE=$P($$SITE^VASITE(),U,3)
S XMLFILE="VAXML"_SITE_".XML"
S HMSDIR=IBCNFPAR(13.01)
S DQUOTE="""",SQUOTE="'",AMP="&",LT="<",GT=">"
S XMLX(DQUOTE)="""
S XMLX(SQUOTE)="&pos;"
S XMLX(AMP)="&"
S XMLX(LT)="<"
S XMLX(GT)=">"
Q
;
TEST ;
;
D OPEN^%ZISH("TXTFILE","USER$:[SMITHK.HMS]","VA123T3.TXT","R")
Q:POP
N XMSUB,IBCSVMSG,XMY,XMTEXT,IBNOW,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR,CR,LF,MCNT,I,SEGS,RCNT
S CR=$C(13),LF=$C(10)
S SEQ=0,MCNT=0,RCNT=0
F D Q:EOF
.U IO
.R REC:2
.S EOF=$$STATUS^%ZISH
.Q:EOF
.S RCNT=RCNT+1
.S SEQ=SEQ+1
.I SEQ=1 S MCNT=MCNT+1,IBCSVMSG(SEQ)="2IBN"_$E("0000",1,4-$L(MCNT))_MCNT_" ABW."
.S SEGS=$L(REC)\100 S:$L(REC)#100 SEGS=SEGS+1
.F I=1:1:SEGS S SEQ=SEQ+1,IBCSVMSG(SEQ)=$E(REC,(I-1)*100+1,I*100)
.I RCNT=100 D
..S SEQ=SEQ+1
..S IBCSVMSG(SEQ)="NNNN "
..D TSEND
..K IBCSVMSG
..S SEQ=0,RCNT=0
S SEQ=SEQ+1,IBCSVMSG(SEQ)=" "
S SEQ=SEQ+1,IBCSVMSG(SEQ)=" "
S SEQ=SEQ+1,IBCSVMSG(SEQ)=" "
S SEQ=SEQ+1,IBCSVMSG(SEQ)=" "
S SEQ=SEQ+1,IBCSVMSG(SEQ)="### END OF FILE ### END OF FILE ### "
S SEQ=SEQ+1,IBCSVMSG(SEQ)="NNNN "
D TSEND
D CLOSE^%ZISH("TXTFILE")
Q
;
TSEND ;
N XMSUB,XMY,XMTEXT,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
S XMSUB="HMS result file"
S XMTEXT="IBCSVMSG("
S XMY("G.IBN")=""
D ^XMD
U 0 W !,XMZ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNFRD2 12454 printed Apr 09, 2024@21:24:51 Page 2
IBCNFRD2 ;WOIFO/KJS - Electronic Insurance Identification ;25-MAY-2011
+1 ;;2.0;INTEGRATED BILLING;**457**;21-MAR-94;Build 30
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;;
+4 ;
+5 ; Electronic Insurance Indentification Sending and Receiving AITC messages
+6 ;
+7 QUIT
+8 ;
BLDXML ;
+1 ;now create the XML file
+2 NEW XMLFILE,XMLHEAD,XMLCOL,SEQ,REC,HMSDIR,XMLX,DQUOTE,SQUOTE,AMP,GT,LT,SITE
+3 DO INITXML
+4 DO OPEN^%ZISH("XMLFILE",HMSDIR,XMLFILE,"W")
+5 if POP
QUIT
+6 USE IO
+7 DO XMLSTART
+8 SET SEQ=0
+9 FOR
SET SEQ=$ORDER(XMLCOL(SEQ))
if SEQ=""
QUIT
DO XMLCOL($PIECE(XMLCOL(SEQ),U,2))
+10 WRITE !,"<Row>"
+11 FOR
SET SEQ=$ORDER(XMLCOL(SEQ))
if SEQ=""
QUIT
DO XMLCELL($PIECE(XMLCOL(SEQ),U,5),"String",$PIECE(XMLCOL(SEQ),U,6))
+12 WRITE !,"</Row>"
+13 SET MSGID=0
SET IBCNT=0
+14 FOR
SET MSGID=$ORDER(^XTMP("IBCNFRD",MSGID))
if 'MSGID
QUIT
Begin DoDot:1
+15 SET IBREC=0
+16 FOR
SET IBREC=$ORDER(^XTMP("IBCNFRD",MSGID,IBREC))
if 'IBREC
QUIT
Begin DoDot:2
+17 SET IBCNT=IBCNT+1
+18 WRITE !,"<Row>"
+19 SET REC=^XTMP("IBCNFRD",MSGID,IBREC)
+20 SET SEQ=0
+21 FOR
SET SEQ=$ORDER(XMLCOL(SEQ))
if SEQ=""
QUIT
Begin DoDot:3
+22 NEW DATA,POS,SUB,DSUB
+23 SET POS=$PIECE(XMLCOL(SEQ),U)
+24 SET DATA=$PIECE(REC,U,+POS)
+25 IF POS["@"
SET SUB=$PIECE(POS,"@",2)
SET DSUB=SUB_"(.DATA)"
DO @DSUB
+26 DO XMLCELL(DATA,$PIECE(XMLCOL(SEQ),U,3),$PIECE(XMLCOL(SEQ),U,4))
End DoDot:3
+27 WRITE !,"</Row>"
End DoDot:2
End DoDot:1
+28 DO XMLEND
+29 DO CLOSE^%ZISH("XMLFILE")
+30 ;
+31 ; Send Email to IBCNF EII XML READY that Result file is ready
+32 NEW XMSUB,IBXMLMSG,XMY,XMTEXT,IBNOW,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
+33 SET XMSUB="HMS result XML file "_HMSDIR_XMLFILE_" is ready"
+34 SET IBXMLMSG(1)="HMS result XML file "_HMSDIR_XMLFILE_" is ready to be retrieved"
+35 SET XMTEXT="IBXMLMSG("
+36 SET XMY("G.IBCNF EII XML READY")=""
+37 DO ^XMD
+38 QUIT
+39 ;
POLDET(DATA) ;policy determination
+1 SET DATA=$SELECT(DATA="00/00/0000":"POLICY NOT FOUND",DATA="12/31/9999":"ACTIVE",1:"INACTIVE")
+2 QUIT
+3 ;
XMLCOL(WIDTH) ;
+1 WRITE !,"<Column ss:StyleID=""s8"" ss:Width=""",WIDTH,"""/>"
+2 QUIT
+3 ;
XMLCELL(DATA,TYPE,STYLE) ;
+1 IF TYPE="DateTime"
Begin DoDot:1
+2 ;check for valid date and if it is valid format it in excel format
+3 ;otherwise, set the cell to a string type and use the original format
+4 NEW %DT,X,Y,YR,MN,DA
+5 SET X=DATA
+6 DO ^%DT
+7 IF Y=-1
SET TYPE="String"
QUIT
+8 SET YR=$PIECE(DATA,"/",3)
SET MN=$PIECE(DATA,"/")
SET DA=$PIECE(DATA,"/",2)
+9 ;excel dates are invalid before 1/1/1900
+10 IF YR<1900
SET TYPE="String"
QUIT
+11 SET DATA=YR_"-"_MN_"-"_DA
End DoDot:1
+12 ;
+13 WRITE !,"<Cell ss:StyleID=""",STYLE,"""><Data ss:Type=""",TYPE,""">",$$XML(DATA),"</Data></Cell>"
+14 QUIT
+15 ;
XML(DATA) ;
+1 NEW DATA2
+2 ;excel 2007 doesn't like escaped xml chars even though documentation says otherwise
+3 ;but CDATA syntax does work
+4 ;
+5 SET DATA2="<![CDATA["_DATA_"]]>"
+6 QUIT DATA2
+7 ;
XMLSTART ;
+1 WRITE "<?xml version=""1.0""?>"
+2 WRITE !,"<?mso-application progid=""Excel.Sheet""?>"
+3 WRITE !,"<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"""
+4 WRITE !,"xmlns:o=""urn:schemas-microsoft-com:office:office"""
+5 WRITE !,"xmlns:x=""urn:schemas-microsoft-com:office:excel"""
+6 WRITE !,"xmlns:ss=""urn:schemas-microsoft-com:office:spreadsheet"""
+7 WRITE !,"xmlns:html=""http://www.w3.org/TR/REC-html40"">"
+8 WRITE !,"<Styles>"
+9 WRITE !,"<Style ss:ID=""Default"" ss:Name=""Normal"">"
+10 WRITE !,"<Alignment ss:Vertical=""Bottom""/>"
+11 WRITE !,"<Borders/>"
+12 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Color=""#000000""/>"
+13 WRITE !,"<Interior/>"
+14 WRITE !,"<NumberFormat/>"
+15 WRITE !,"<Protection/>"
+16 WRITE !,"</Style>"
+17 WRITE !,"<Style ss:ID=""s1"">"
+18 WRITE !,"<NumberFormat ss:Format=""Short Date""/>"
+19 WRITE !,"</Style>"
+20 WRITE !,"<Style ss:ID=""s2"">"
+21 WRITE !,"<NumberFormat/>"
+22 WRITE !,"</Style>"
+23 WRITE !,"<Style ss:ID=""s3"">"
+24 WRITE !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
+25 WRITE !,"<Borders>"
+26 WRITE !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+27 WRITE !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+28 WRITE !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+29 WRITE !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+30 WRITE !,"</Borders>"
+31 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8""/>"
+32 WRITE !,"<NumberFormat ss:Format=""Short Date""/>"
+33 WRITE !,"</Style>"
+34 WRITE !,"<Style ss:ID=""s4"">"
+35 WRITE !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
+36 WRITE !,"<Borders>"
+37 WRITE !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+38 WRITE !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+39 WRITE !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+40 WRITE !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+41 WRITE !,"</Borders>"
+42 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8""/>"
+43 WRITE !,"<NumberFormat ss:Format=""@""/>"
+44 WRITE !,"</Style>"
+45 WRITE !,"<Style ss:ID=""s5"">"
+46 WRITE !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
+47 WRITE !,"</Style>"
+48 WRITE !,"<Style ss:ID=""s6"">"
+49 WRITE !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
+50 WRITE !,"<Borders>"
+51 WRITE !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+52 WRITE !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+53 WRITE !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+54 WRITE !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+55 WRITE !,"</Borders>"
+56 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#FFFFFF"" ss:Bold=""1""/>"
+57 WRITE !,"<Interior ss:Color=""#000000"" ss:Pattern=""Solid""/>"
+58 WRITE !,"</Style>"
+59 WRITE !,"<Style ss:ID=""s7"">"
+60 WRITE !,"<Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>"
+61 WRITE !,"<Borders>"
+62 WRITE !,"<Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+63 WRITE !,"<Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+64 WRITE !,"<Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+65 WRITE !,"<Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>"
+66 WRITE !,"</Borders>"
+67 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#FFFF00"" ss:Bold=""1""/>"
+68 WRITE !,"<Interior ss:Color=""#000000"" ss:Pattern=""Solid""/>"
+69 WRITE !,"</Style>"
+70 WRITE !,"<Style ss:ID=""s8"">"
+71 WRITE !,"<Font ss:FontName=""Arial"" x:Family=""Swiss"" ss:Size=""8"" ss:Color=""#000000""/>"
+72 WRITE !,"</Style>"
+73 WRITE !,"</Styles>"
+74 WRITE !,"<Worksheet ss:Name=""",$PIECE(XMLFILE,"."),""">"
+75 WRITE !,"<Table x:FullColumns=""1"" x:FullRows=""1"" ss:DefaultRowHeight=""11.25"">"
+76 QUIT
+77 ;
XMLEND ;
+1 WRITE !,"</Table>"
+2 WRITE !,"<WorksheetOptions xmlns=""urn:schemas-microsoft-com:office:excel"">"
+3 WRITE !,"<PageSetup>"
+4 WRITE !,"<Header x:Data=""&L&D&R&"Arial,Bold"&8HMS Insurance Identification Results""/>"
+5 WRITE !,"<Footer x:Data=""&F&RPage &P""/>"
+6 WRITE !,"</PageSetup>"
+7 WRITE !,"<FreezePanes/>"
+8 WRITE !,"<FrozenNoSplit/>"
+9 WRITE !,"<SplitHorizontal>1</SplitHorizontal>"
+10 WRITE !,"<TopRowBottomPane>1</TopRowBottomPane>"
+11 WRITE !,"</WorksheetOptions>"
+12 WRITE !,"</Worksheet>"
+13 WRITE !,"</Workbook>"
+14 QUIT
+15 ;
INITXML ;
+1 ;XMLCOL(N)=P^W^T^SC^H^SH
+2 ;N=column number in spreadsheet
+3 ;P=piece number from result file record
+4 ;W=width of column
+5 ;T=cell type
+6 ;SC=cell style
+7 ;H=HEADER
+8 ;SH=header style
+9 ;
+10 NEW COL
+11 SET COL=0
+12 SET COL=COL+1
SET XMLCOL(COL)="1^57^String^s4^Autonumber^s6"
+13 SET COL=COL+1
SET XMLCOL(COL)="2^96^String^s4^Patient Name^s6"
+14 SET COL=COL+1
SET XMLCOL(COL)="3^51.75^String^s4^Patient SSN^s6"
+15 SET COL=COL+1
SET XMLCOL(COL)="4^52.5^DateTime^s3^Patient DOB^s6"
+16 SET COL=COL+1
SET XMLCOL(COL)="5^52.5^String^s4^Patient Age^s6"
+17 SET COL=COL+1
SET XMLCOL(COL)="70^87^String^s4^Pt. Rel. to Insured ID^s6"
+18 SET COL=COL+1
SET XMLCOL(COL)="71^69^String^s4^Pat. ID^s6"
+19 SET COL=COL+1
SET XMLCOL(COL)="6^186.75^String^s4^Carrier Name^s6"
+20 SET COL=COL+1
SET XMLCOL(COL)="7^63^String^s4^Carrier Phone^s6"
+21 SET COL=COL+1
SET XMLCOL(COL)="8^60.75^DateTime^s3^Effective Date^s6"
+22 SET COL=COL+1
SET XMLCOL(COL)="9^75^String^s4^Insurance Active^s6"
+23 SET COL=COL+1
SET XMLCOL(COL)="10^45.75^DateTime^s3^Thru Date^s6"
+24 SET COL=COL+1
SET XMLCOL(COL)="11^80.25^String^s4^Group ID^s6"
+25 SET COL=COL+1
SET XMLCOL(COL)="12^108^String^s4^Group Name^s6"
+26 SET COL=COL+1
SET XMLCOL(COL)="13^105^String^s4^Carrier Address 1^s6"
+27 SET COL=COL+1
SET XMLCOL(COL)="14^99.75^String^s4^Carrier Address 2^s6"
+28 SET COL=COL+1
SET XMLCOL(COL)="15^75^String^s4^Carrier City^s6"
+29 SET COL=COL+1
SET XMLCOL(COL)="16^57.75^String^s4^Carrier State^s6"
+30 SET COL=COL+1
SET XMLCOL(COL)="17^49.5^String^s4^Carrier Zip^s6"
+31 SET COL=COL+1
SET XMLCOL(COL)="18^105^String^s4^Out Patient Address 1^s6"
+32 SET COL=COL+1
SET XMLCOL(COL)="19^99.75^String^s4^Out Patient Address 2^s6"
+33 SET COL=COL+1
SET XMLCOL(COL)="20^75^String^s4^Out Patient City^s6"
+34 SET COL=COL+1
SET XMLCOL(COL)="21^74.25^String^s4^Out Patient State^s6"
+35 SET COL=COL+1
SET XMLCOL(COL)="22^65.25^String^s4^Out Patient Zip^s6"
+36 SET COL=COL+1
SET XMLCOL(COL)="23^113.25^String^s4^Policy Holder Name^s6"
+37 SET COL=COL+1
SET XMLCOL(COL)="24^48.75^DateTime^s3^Policy DOB^s6"
+38 SET COL=COL+1
SET XMLCOL(COL)="25^69^String^s4^Policy Holder ID^s6"
+39 SET COL=COL+1
SET XMLCOL(COL)="26^50.25^String^s4^Filing Limit^s6"
+40 SET COL=COL+1
SET XMLCOL(COL)="65^96^String^s4^Coverage Type^s6"
+41 SET COL=COL+1
SET XMLCOL(COL)="38^43.5^String^s4^Medicare^s6"
+42 SET COL=COL+1
SET XMLCOL(COL)="39^30^String^s4^Part A^s6"
+43 SET COL=COL+1
SET XMLCOL(COL)="40^29.25^String^s4^Part B^s6"
+44 SET COL=COL+1
SET XMLCOL(COL)="41^53.25^String^s4^MC Primary^s6"
+45 SET COL=COL+1
SET XMLCOL(COL)="42^77.25^DateTime^s3^MC Effective Date^s6"
+46 SET COL=COL+1
SET XMLCOL(COL)="43^64.5^String^s4^MC Secondary^s6"
+47 SET COL=COL+1
SET XMLCOL(COL)="44^66.75^String^s4^Medicare Supp^s6"
+48 SET COL=COL+1
SET XMLCOL(COL)="45^38.25^String^s4^MC Plan^s6"
+49 SET COL=COL+1
SET XMLCOL(COL)="46^61.5^String^s4^MC Carve Out^s6"
+50 SET COL=COL+1
SET XMLCOL(COL)="47^39.75^String^s4^MC HMO^s6"
+51 SET COL=COL+1
SET XMLCOL(COL)="48^57.75^String^s4^RX Coverage^s6"
+52 SET COL=COL+1
SET XMLCOL(COL)="50^151.5^String^s4^RX Name^s6"
+53 SET COL=COL+1
SET XMLCOL(COL)="51^120.75^String^s4^RX Address^s6"
+54 SET COL=COL+1
SET XMLCOL(COL)="52^61.5^String^s4^RX City^s6"
+55 SET COL=COL+1
SET XMLCOL(COL)="53^39^String^s4^RX State^s6"
+56 SET COL=COL+1
SET XMLCOL(COL)="54^30.75^String^s4^RX Zip^s6"
+57 SET COL=COL+1
SET XMLCOL(COL)="55^72.75^String^s4^Pre Certification^s6"
+58 SET COL=COL+1
SET XMLCOL(COL)="56^69^String^s4^Pre Cert Phone^s6"
+59 SET COL=COL+1
SET XMLCOL(COL)="57^83.25^String^s4^Pre Cert Contact^s6"
+60 SET COL=COL+1
SET XMLCOL(COL)="58^45.75^String^s4^Bill Phone^s6"
+61 SET COL=COL+1
SET XMLCOL(COL)="59^73.5^DateTime^s3^Verification Date^s6"
+62 SET COL=COL+1
SET XMLCOL(COL)="60^83.25^String^s4^Verified By^s6"
+63 SET COL=COL+1
SET XMLCOL(COL)="61^96.75^String^s4^Verification Complete^s6"
+64 SET COL=COL+1
SET XMLCOL(COL)="62^40.5^String^s4^File ID^s6"
+65 SET COL=COL+1
SET XMLCOL(COL)="67^53.25^String^s4^Bin Number^s6"
+66 SET COL=COL+1
SET XMLCOL(COL)="68^57^String^s4^PCN Number^s6"
+67 SET COL=COL+1
SET XMLCOL(COL)="69^50.25^String^s4^RX Phone^s6"
+68 SET COL=COL+1
SET XMLCOL(COL)="10@POLDET^91.5^String^s4^Policy Determination^s6"
+69 SET COL=COL+1
SET XMLCOL(COL)="73^51.75^String^s4^Terminator^s6"
+70 SET SITE=$PIECE($$SITE^VASITE(),U,3)
+71 SET XMLFILE="VAXML"_SITE_".XML"
+72 SET HMSDIR=IBCNFPAR(13.01)
+73 SET DQUOTE=""""
SET SQUOTE="'"
SET AMP="&"
SET LT="<"
SET GT=">"
+74 SET XMLX(DQUOTE)="""
+75 SET XMLX(SQUOTE)="&pos;"
+76 SET XMLX(AMP)="&"
+77 SET XMLX(LT)="<"
+78 SET XMLX(GT)=">"
+79 QUIT
+80 ;
TEST ;
+1 ;
+2 DO OPEN^%ZISH("TXTFILE","USER$:[SMITHK.HMS]","VA123T3.TXT","R")
+3 if POP
QUIT
+4 NEW XMSUB,IBCSVMSG,XMY,XMTEXT,IBNOW,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR,CR,LF,MCNT,I,SEGS,RCNT
+5 SET CR=$CHAR(13)
SET LF=$CHAR(10)
+6 SET SEQ=0
SET MCNT=0
SET RCNT=0
+7 FOR
Begin DoDot:1
+8 USE IO
+9 READ REC:2
+10 SET EOF=$$STATUS^%ZISH
+11 if EOF
QUIT
+12 SET RCNT=RCNT+1
+13 SET SEQ=SEQ+1
+14 IF SEQ=1
SET MCNT=MCNT+1
SET IBCSVMSG(SEQ)="2IBN"_$EXTRACT("0000",1,4-$LENGTH(MCNT))_MCNT_" ABW."
+15 SET SEGS=$LENGTH(REC)\100
if $LENGTH(REC)#100
SET SEGS=SEGS+1
+16 FOR I=1:1:SEGS
SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)=$EXTRACT(REC,(I-1)*100+1,I*100)
+17 IF RCNT=100
Begin DoDot:2
+18 SET SEQ=SEQ+1
+19 SET IBCSVMSG(SEQ)="NNNN "
+20 DO TSEND
+21 KILL IBCSVMSG
+22 SET SEQ=0
SET RCNT=0
End DoDot:2
End DoDot:1
if EOF
QUIT
+23 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)=" "
+24 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)=" "
+25 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)=" "
+26 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)=" "
+27 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)="### END OF FILE ### END OF FILE ### "
+28 SET SEQ=SEQ+1
SET IBCSVMSG(SEQ)="NNNN "
+29 DO TSEND
+30 DO CLOSE^%ZISH("TXTFILE")
+31 QUIT
+32 ;
TSEND ;
+1 NEW XMSUB,XMY,XMTEXT,XMZ,XMDUZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
+2 SET XMSUB="HMS result file"
+3 SET XMTEXT="IBCSVMSG("
+4 SET XMY("G.IBN")=""
+5 DO ^XMD
+6 USE 0
WRITE !,XMZ
+7 QUIT
