- ABMDBLK ; IHS/ASDST/DMJ - Bill Selection ;
- ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213
- ;
- ; IHS/ASDS/DMJ - 05/15/00 - V2.4 Patch 1 - NOIS HQW-0500-100032
- ; Modified to allow population of the PIN number for KIDSCARE as well as visit type 999.
- ; IHS/SD/SDR - 10/10/02 - V2.5 P2 - OFB-0802-190066
- ; Modified to put provider # in block 33 for Medicare insurers
- ; IHS/SD/SDR - v2.5 p8 - IM14823 - Modified to not print Medicaid number when PI claim
- ; IHS/SD/SDR - v2.5 p9 - IM16942 - For OK Medicaid - if VT 999 - print payer assigned provider#
- ; if not VT 999-PIN# from Insurer file
- ;IHS/SD/SDR - 2.6*13 - Added checks for new export mode 35
- ;
- BILL ;SELECT BILL
- K %P,DIC,ABMP("BDFN"),ABM
- S DIR("A")="Select BILL or PATIENT"
- S DIR("?")="Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
- W !
- S DIR(0)="FO" D ^DIR K DIR
- Q:$D(DIRUT)
- S ABM("INPUT")=Y
- I $D(^ABMDBILL(DUZ(2),"B",Y)),Y'=+Y D
- .S X=Y
- .S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
- .I +Y>0 S ABMP("BDFN")=+Y
- I $G(ABMP("BDFN")) K ABM Q
- I Y=+Y,$D(^ABMDBILL(DUZ(2),"B",Y)) D
- .S X=Y
- .S DIC="^ABMDBILL(DUZ(2),",DIC(0)="EM" D ^DIC
- .I +Y>0 D
- ..S ABMP("BDFN")=+Y
- ..S DIR("A")="Correct Bill",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
- ..I Y='1 K ABMP("BDFN")
- I $G(ABMP("BDFN")) K ABM Q
- S ABM("STATUS")=$P(^DD(9002274.4,.04,0),"^",3)
- NUM ;NUMBER LOOKUP
- S Y=ABM("INPUT")
- I +Y D
- .S J=+Y_" ",ABM("CNT")=0 F S J=$O(^ABMDBILL(DUZ(2),"B",J)) Q:J'[+Y!($G(ABMP("BDFN"))) D
- ..S I=$O(^ABMDBILL(DUZ(2),"B",J,0))
- ..S ABMP("PDFN")=$P(^ABMDBILL(DUZ(2),I,0),"^",5)
- ..D ID
- .D:(ABM("CNT")#5) SEL
- I $G(ABMP("BDFN")) K ABM Q
- PAT ;PATIENT LOOKUP
- S X=ABM("INPUT"),DIC="^AUPNPAT(",DIC(0)="EMQ",AUPNLK("ALL")=1
- D ^DIC
- I +Y<0 G BILL
- S ABMP("PDFN")=+Y,ABM("P0")=^DPT(ABMP("PDFN"),0)
- S $P(ABM("="),"=",80)=""
- D PAT^ABMDUTL(ABMP("PDFN"))
- S I="",ABM("CNT")=0
- F S I=$O(^ABMDBILL(DUZ(2),"D",ABMP("PDFN"),I)) Q:'I!($G(ABMP("BDFN")))!($D(DIRUT)) D
- .Q:$P(^ABMDBILL(DUZ(2),I,0),"^",7)'=111
- .Q:$P(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
- .D ID
- .I '(ABM("CNT")#5) D SEL
- I '$G(ABMP("BDFN")) D SEL
- I '$G(ABMP("BDFN")) G BILL
- K ABM Q
- ID ;BILL IDENTIFIERS
- I '(ABM("CNT")#5) D PAT^ABMDUTL(ABMP("PDFN"))
- S ABM("CNT")=ABM("CNT")+1
- S ABM("CNT",ABM("CNT"))=I
- W !!,"(",ABM("CNT"),")"
- S ABM("ZERO")=^ABMDBILL(DUZ(2),I,0) N J F J=1:1:12 S ABM(J)=$P(ABM("ZERO"),"^",J)
- S ABM(7,1)=$P($G(^ABMDBILL(DUZ(2),I,7)),"^",1),ABM(2,1)=$P($G(^(2)),"^",1)
- S ABM(4)=$P(ABM("STATUS"),ABM(4)_":",2),ABM(4)=$P(ABM(4),";",1)
- W ?5,"Bill# ",ABM(1)
- W ?20,$$SDT^ABMDUTL(ABM(7,1))
- W ?30,$P($G(^ABMDVTYP(+ABM(7),0)),"^",1)
- W ?51,$P($G(^DIC(40.7,+ABM(10),0)),"^",1)
- W ?67,$P($G(^AUTTLOC(+ABM(3),0)),"^",2)
- W !,?6,$P($G(^ABMDEXP(+ABM(6),0)),"^",1)
- W ?18,$E(ABM(4),1,15)
- W ?37,$P($G(^AUTNINS(+ABM(8),0)),"^",1)
- W ?70,$J($FN(ABM(2,1),",",2),10)
- Q
- SEL ;SELECT
- F W ! Q:$Y+4>IOSL
- S DIR(0)="NAO^1:"_ABM("CNT"),DIR("A")="Select 1 to "_ABM("CNT")_": " D ^DIR K DIR
- I Y S ABMP("BDFN")=ABM("CNT",Y)
- I Y="",'$D(DTOUT) K DIRUT
- Q
- ;
- BENT ;EP - for doing Bill File lookup with DIC variables
- K ABMP("BDFN")
- S AUPNLK("ALL")=1
- S DIC("W")="S ABM(0)=^(0),ABM(2)=+$G(^(2)),ABM(7)=$S(+$G(^(7)):^(7),1:+$G(^(6))) D DICW^ABMDBDIC"
- D ^DIC K DIC
- G XIT:X=""!$D(DUOUT)!$D(DTOUT)
- I X="?" W !!,"Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
- G BENT:+Y<1 S ABMP("BDFN")=+Y
- G XIT
- ;
- DICW ;EP - for displaying bill identifiers
- I $G(DZ)["?",$P(ABM(0),U,5),$D(^DPT($P(ABM(0),U,5),0)) S ABMDPT=^(0) D
- .W ?12,$P(ABMDPT,U)
- .W ?46,$P(ABMDPT,U,2)
- .W " ",$$HDT^ABMDUTL($P(ABMDPT,"^",3))
- .W " ",$P(ABMDPT,U,9)
- I I $G(DUZ(2)),$D(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0)) W ?68,$P($G(^AUTTLOC(DUZ(2),0)),U,7)," ",$P(^AUPNPAT($P(ABM(0),U,5),41,DUZ(2),0),U,2)
- I $G(X)'=$P(ABM(0),U,5)!($G(DZ)["?") W !
- W ?17,"Visit: ",$$HDT^ABMDUTL(ABM(7))," "
- I $P(ABM(0),U,7) W $E($P($G(^ABMDVTYP($P(ABM(0),U,7),0)),U),1,14)
- I $P(ABM(0),U,10),$P(ABM(0),U,3) W ?49,$E($P($G(^DIC(40.7,$P(ABM(0),U,10),0)),U),1,17),?68,$E($P($G(^AUTTLOC($P(ABM(0),U,3),0)),U,2),1,12)
- W !?20,"Bill: ",$P(^AUTNINS($P(ABM(0),U,8),0),U)
- I $P(ABM(0),U,6) W ?57,$P($G(^ABMDEXP($P(ABM(0),U,6),0)),U)
- W ?68,$J($FN(ABM(2),",",2),10)
- S DIW=1
- I $G(DZ)["?" W !
- K ABM(0),ABM(7)
- Q
- ;
- XIT K ABM
- Q
- ;
- MULT ;EP for Selecting Multiple Bills
- K DIC S ABM("C")=0,DIC="^ABMDBILL(DUZ(2),",DIC(0)="QEAM" W !
- F ABM=1:1 W ! D Q:X=""!$D(DUOUT)!$D(DTOUT)
- SELO .S ABM("E")=$E(ABM,$L(ABM)),DIC("A")="Select "_ABM_$S(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL: ",DIC(0)="QEAM" D ^DIC
- .Q:X=""!$D(DUOUT)!$D(DTOUT)
- .I +Y<1 G SELO
- .S ABMM(+Y)=""
- K DIC
- G XIT
- 54 ;EP - get prov number
- Q:'$$F54^ABMDFUTL
- S ABMPROV=$P(ABM("A"),"^",2)
- I ABMPROV D
- .S ABMPNUM=$P($G(^VA(200,ABMPROV,9999999.18,+ABMP("INS"),0)),"^",2)
- I $G(ABMPNUM)="",ABMP("ITYPE")="R" D
- .S ABMPNUM=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- I ABMP("VTYP")=999,($P($G(^AUTNINS(ABMP("INS"),0)),U)["OKLAHOMA MEDICAID") D Q
- .;start old code abm*2.6*13 Export mode 35
- .;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- .;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:5,1:4))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,6)
- .;end old start new export mode 35
- .S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35):4,1:3))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- .S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35):5,1:4))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,6)
- .;end new export mode 35
- I $G(ABMPNUM)="",(ABMP("ITYPE")="D") D
- .S ABMPNUM=$P($G(^VA(200,ABMPROV,9999999)),"^",7)
- ;start old code abm*2.6*13 Export mode 35
- ;I $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))'="" D
- ;.S:$G(ABMP("EXP"))=27 $P(ABMF(54),U,5)=$P(ABMF(54),U,4)
- ;end old start new export mode 35
- I $P(ABMF(54),U,$S($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35):4,1:3))'="" D
- .S:($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35)) $P(ABMF(54),U,5)=$P(ABMF(54),U,4)
- .;end new export mode 35
- .E S $P(ABMF(54),U,4)=$P(ABMF(54),U,3)
- ;start old code abm*2.6*13 export mode 35
- ;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))=ABMPNUM
- ;S:$G(ABMP("EXP"))=27 $P(ABMF(54),U,4)=$S($P($$NPI^XUSNPI("Individual_ID",ABMPROV),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABMPROV),U),1:"")
- ;end old start new export mode 35
- S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35):4,1:3))=ABMPNUM
- S:($G(ABMP("EXP"))=27!($G(ABMP("EXP"))=35)) $P(ABMF(54),U,4)=$S($P($$NPI^XUSNPI("Individual_ID",ABMPROV),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABMPROV),U),1:"")
- ;end new export mode 35
- Q
- ABMDBLK ; IHS/ASDST/DMJ - Bill Selection ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213
- +2 ;
- +3 ; IHS/ASDS/DMJ - 05/15/00 - V2.4 Patch 1 - NOIS HQW-0500-100032
- +4 ; Modified to allow population of the PIN number for KIDSCARE as well as visit type 999.
- +5 ; IHS/SD/SDR - 10/10/02 - V2.5 P2 - OFB-0802-190066
- +6 ; Modified to put provider # in block 33 for Medicare insurers
- +7 ; IHS/SD/SDR - v2.5 p8 - IM14823 - Modified to not print Medicaid number when PI claim
- +8 ; IHS/SD/SDR - v2.5 p9 - IM16942 - For OK Medicaid - if VT 999 - print payer assigned provider#
- +9 ; if not VT 999-PIN# from Insurer file
- +10 ;IHS/SD/SDR - 2.6*13 - Added checks for new export mode 35
- +11 ;
- BILL ;SELECT BILL
- +1 KILL %P,DIC,ABMP("BDFN"),ABM
- +2 SET DIR("A")="Select BILL or PATIENT"
- +3 SET DIR("?")="Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
- +4 WRITE !
- +5 SET DIR(0)="FO"
- DO ^DIR
- KILL DIR
- +6 IF $DATA(DIRUT)
- QUIT
- +7 SET ABM("INPUT")=Y
- +8 IF $DATA(^ABMDBILL(DUZ(2),"B",Y))
- IF Y'=+Y
- Begin DoDot:1
- +9 SET X=Y
- +10 SET DIC="^ABMDBILL(DUZ(2),"
- SET DIC(0)="EM"
- DO ^DIC
- +11 IF +Y>0
- SET ABMP("BDFN")=+Y
- End DoDot:1
- +12 IF $GET(ABMP("BDFN"))
- KILL ABM
- QUIT
- +13 IF Y=+Y
- IF $DATA(^ABMDBILL(DUZ(2),"B",Y))
- Begin DoDot:1
- +14 SET X=Y
- +15 SET DIC="^ABMDBILL(DUZ(2),"
- SET DIC(0)="EM"
- DO ^DIC
- +16 IF +Y>0
- Begin DoDot:2
- +17 SET ABMP("BDFN")=+Y
- +18 SET DIR("A")="Correct Bill"
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- +19 IF Y='1
- KILL ABMP("BDFN")
- End DoDot:2
- End DoDot:1
- +20 IF $GET(ABMP("BDFN"))
- KILL ABM
- QUIT
- +21 SET ABM("STATUS")=$PIECE(^DD(9002274.4,.04,0),"^",3)
- NUM ;NUMBER LOOKUP
- +1 SET Y=ABM("INPUT")
- +2 IF +Y
- Begin DoDot:1
- +3 SET J=+Y_" "
- SET ABM("CNT")=0
- FOR
- SET J=$ORDER(^ABMDBILL(DUZ(2),"B",J))
- IF J'[+Y!($GET(ABMP("BDFN")))
- QUIT
- Begin DoDot:2
- +4 SET I=$ORDER(^ABMDBILL(DUZ(2),"B",J,0))
- +5 SET ABMP("PDFN")=$PIECE(^ABMDBILL(DUZ(2),I,0),"^",5)
- +6 DO ID
- End DoDot:2
- +7 IF (ABM("CNT")#5)
- DO SEL
- End DoDot:1
- +8 IF $GET(ABMP("BDFN"))
- KILL ABM
- QUIT
- PAT ;PATIENT LOOKUP
- +1 SET X=ABM("INPUT")
- SET DIC="^AUPNPAT("
- SET DIC(0)="EMQ"
- SET AUPNLK("ALL")=1
- +2 DO ^DIC
- +3 IF +Y<0
- GOTO BILL
- +4 SET ABMP("PDFN")=+Y
- SET ABM("P0")=^DPT(ABMP("PDFN"),0)
- +5 SET $PIECE(ABM("="),"=",80)=""
- +6 DO PAT^ABMDUTL(ABMP("PDFN"))
- +7 SET I=""
- SET ABM("CNT")=0
- +8 FOR
- SET I=$ORDER(^ABMDBILL(DUZ(2),"D",ABMP("PDFN"),I))
- IF 'I!($GET(ABMP("BDFN")))!($DATA(DIRUT))
- QUIT
- Begin DoDot:1
- +9 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",7)'=111
- QUIT
- +10 IF $PIECE(^ABMDBILL(DUZ(2),I,0),"^",8)'=ABMINS
- QUIT
- +11 DO ID
- +12 IF '(ABM("CNT")#5)
- DO SEL
- End DoDot:1
- +13 IF '$GET(ABMP("BDFN"))
- DO SEL
- +14 IF '$GET(ABMP("BDFN"))
- GOTO BILL
- +15 KILL ABM
- QUIT
- ID ;BILL IDENTIFIERS
- +1 IF '(ABM("CNT")#5)
- DO PAT^ABMDUTL(ABMP("PDFN"))
- +2 SET ABM("CNT")=ABM("CNT")+1
- +3 SET ABM("CNT",ABM("CNT"))=I
- +4 WRITE !!,"(",ABM("CNT"),")"
- +5 SET ABM("ZERO")=^ABMDBILL(DUZ(2),I,0)
- NEW J
- FOR J=1:1:12
- SET ABM(J)=$PIECE(ABM("ZERO"),"^",J)
- +6 SET ABM(7,1)=$PIECE($GET(^ABMDBILL(DUZ(2),I,7)),"^",1)
- SET ABM(2,1)=$PIECE($GET(^(2)),"^",1)
- +7 SET ABM(4)=$PIECE(ABM("STATUS"),ABM(4)_":",2)
- SET ABM(4)=$PIECE(ABM(4),";",1)
- +8 WRITE ?5,"Bill# ",ABM(1)
- +9 WRITE ?20,$$SDT^ABMDUTL(ABM(7,1))
- +10 WRITE ?30,$PIECE($GET(^ABMDVTYP(+ABM(7),0)),"^",1)
- +11 WRITE ?51,$PIECE($GET(^DIC(40.7,+ABM(10),0)),"^",1)
- +12 WRITE ?67,$PIECE($GET(^AUTTLOC(+ABM(3),0)),"^",2)
- +13 WRITE !,?6,$PIECE($GET(^ABMDEXP(+ABM(6),0)),"^",1)
- +14 WRITE ?18,$EXTRACT(ABM(4),1,15)
- +15 WRITE ?37,$PIECE($GET(^AUTNINS(+ABM(8),0)),"^",1)
- +16 WRITE ?70,$JUSTIFY($FNUMBER(ABM(2,1),",",2),10)
- +17 QUIT
- SEL ;SELECT
- +1 FOR
- WRITE !
- IF $Y+4>IOSL
- QUIT
- +2 SET DIR(0)="NAO^1:"_ABM("CNT")
- SET DIR("A")="Select 1 to "_ABM("CNT")_": "
- DO ^DIR
- KILL DIR
- +3 IF Y
- SET ABMP("BDFN")=ABM("CNT",Y)
- +4 IF Y=""
- IF '$DATA(DTOUT)
- KILL DIRUT
- +5 QUIT
- +6 ;
- BENT ;EP - for doing Bill File lookup with DIC variables
- +1 KILL ABMP("BDFN")
- +2 SET AUPNLK("ALL")=1
- +3 SET DIC("W")="S ABM(0)=^(0),ABM(2)=+$G(^(2)),ABM(7)=$S(+$G(^(7)):^(7),1:+$G(^(6))) D DICW^ABMDBDIC"
- +4 DO ^DIC
- KILL DIC
- +5 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
- GOTO XIT
- +6 IF X="?"
- WRITE !!,"Enter either the Bill Number or a Patient Identifier (Name, HRN, SSN, DOB)"
- +7 IF +Y<1
- GOTO BENT
- SET ABMP("BDFN")=+Y
- +8 GOTO XIT
- +9 ;
- DICW ;EP - for displaying bill identifiers
- +1 IF $GET(DZ)["?"
- IF $PIECE(ABM(0),U,5)
- IF $DATA(^DPT($PIECE(ABM(0),U,5),0))
- SET ABMDPT=^(0)
- Begin DoDot:1
- +2 WRITE ?12,$PIECE(ABMDPT,U)
- +3 WRITE ?46,$PIECE(ABMDPT,U,2)
- +4 WRITE " ",$$HDT^ABMDUTL($PIECE(ABMDPT,"^",3))
- +5 WRITE " ",$PIECE(ABMDPT,U,9)
- End DoDot:1
- +6 IF $TEST
- IF $GET(DUZ(2))
- IF $DATA(^AUPNPAT($PIECE(ABM(0),U,5),41,DUZ(2),0))
- WRITE ?68,$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,7)," ",$PIECE(^AUPNPAT($PIECE(ABM(0),U,5),41,DUZ(2),0),U,2)
- +7 IF $GET(X)'=$PIECE(ABM(0),U,5)!($GET(DZ)["?")
- WRITE !
- +8 WRITE ?17,"Visit: ",$$HDT^ABMDUTL(ABM(7))," "
- +9 IF $PIECE(ABM(0),U,7)
- WRITE $EXTRACT($PIECE($GET(^ABMDVTYP($PIECE(ABM(0),U,7),0)),U),1,14)
- +10 IF $PIECE(ABM(0),U,10)
- IF $PIECE(ABM(0),U,3)
- WRITE ?49,$EXTRACT($PIECE($GET(^DIC(40.7,$PIECE(ABM(0),U,10),0)),U),1,17),?68,$EXTRACT($PIECE($GET(^AUTTLOC($PIECE(ABM(0),U,3),0)),U,2),1,12)
- +11 WRITE !?20,"Bill: ",$PIECE(^AUTNINS($PIECE(ABM(0),U,8),0),U)
- +12 IF $PIECE(ABM(0),U,6)
- WRITE ?57,$PIECE($GET(^ABMDEXP($PIECE(ABM(0),U,6),0)),U)
- +13 WRITE ?68,$JUSTIFY($FNUMBER(ABM(2),",",2),10)
- +14 SET DIW=1
- +15 IF $GET(DZ)["?"
- WRITE !
- +16 KILL ABM(0),ABM(7)
- +17 QUIT
- +18 ;
- XIT KILL ABM
- +1 QUIT
- +2 ;
- MULT ;EP for Selecting Multiple Bills
- +1 KILL DIC
- SET ABM("C")=0
- SET DIC="^ABMDBILL(DUZ(2),"
- SET DIC(0)="QEAM"
- WRITE !
- +2 FOR ABM=1:1
- WRITE !
- Begin DoDot:1
- SELO SET ABM("E")=$EXTRACT(ABM,$LENGTH(ABM))
- SET DIC("A")="Select "_ABM_$SELECT(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL: "
- SET DIC(0)="QEAM"
- DO ^DIC
- +1 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +2 IF +Y<1
- GOTO SELO
- +3 SET ABMM(+Y)=""
- End DoDot:1
- IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +4 KILL DIC
- +5 GOTO XIT
- 54 ;EP - get prov number
- +1 IF '$$F54^ABMDFUTL
- QUIT
- +2 SET ABMPROV=$PIECE(ABM("A"),"^",2)
- +3 IF ABMPROV
- Begin DoDot:1
- +4 SET ABMPNUM=$PIECE($GET(^VA(200,ABMPROV,9999999.18,+ABMP("INS"),0)),"^",2)
- End DoDot:1
- +5 IF $GET(ABMPNUM)=""
- IF ABMP("ITYPE")="R"
- Begin DoDot:1
- +6 SET ABMPNUM=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- End DoDot:1
- +7 IF ABMP("VTYP")=999
- IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["OKLAHOMA MEDICAID")
- Begin DoDot:1
- +8 ;start old code abm*2.6*13 Export mode 35
- +9 ;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- +10 ;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:5,1:4))=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,6)
- +11 ;end old start new export mode 35
- +12 SET $PIECE(ABMF(54),U,$SELECT($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35):4,1:3))=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),3,ABMPROV,0)),U,2)
- +13 SET $PIECE(ABMF(54),U,$SELECT($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35):5,1:4))=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,6)
- +14 ;end new export mode 35
- End DoDot:1
- QUIT
- +15 IF $GET(ABMPNUM)=""
- IF (ABMP("ITYPE")="D")
- Begin DoDot:1
- +16 SET ABMPNUM=$PIECE($GET(^VA(200,ABMPROV,9999999)),"^",7)
- End DoDot:1
- +17 ;start old code abm*2.6*13 Export mode 35
- +18 ;I $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))'="" D
- +19 ;.S:$G(ABMP("EXP"))=27 $P(ABMF(54),U,5)=$P(ABMF(54),U,4)
- +20 ;end old start new export mode 35
- +21 IF $PIECE(ABMF(54),U,$SELECT($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35):4,1:3))'=""
- Begin DoDot:1
- +22 IF ($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35))
- SET $PIECE(ABMF(54),U,5)=$PIECE(ABMF(54),U,4)
- +23 ;end new export mode 35
- +24 IF '$TEST
- SET $PIECE(ABMF(54),U,4)=$PIECE(ABMF(54),U,3)
- End DoDot:1
- +25 ;start old code abm*2.6*13 export mode 35
- +26 ;S $P(ABMF(54),U,$S($G(ABMP("EXP"))=27:4,1:3))=ABMPNUM
- +27 ;S:$G(ABMP("EXP"))=27 $P(ABMF(54),U,4)=$S($P($$NPI^XUSNPI("Individual_ID",ABMPROV),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABMPROV),U),1:"")
- +28 ;end old start new export mode 35
- +29 SET $PIECE(ABMF(54),U,$SELECT($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35):4,1:3))=ABMPNUM
- +30 IF ($GET(ABMP("EXP"))=27!($GET(ABMP("EXP"))=35))
- SET $PIECE(ABMF(54),U,4)=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",ABMPROV),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",ABMPROV),U),1:"")
- +31 ;end new export mode 35
- +32 QUIT
