ABMDF35D ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array - Part 4 ;
;;2.6;IHS Third Party Billing;**13,14,22**;NOV 12, 2009;Build 418
;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
;IHS/SD/SDR 2.6*22 HEAT335246 check new parameter for itemized but with the flat rate on first line, zeros for the rest
;
; *********************************************************************
;
DX ; Diagnosis Info
K ABMP("DX")
S ABM=""
S ABM("ID")=31
S ABM("TB")=1
S ABMDXQ=0
F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM!(ABM>12) D Q:ABMDXQ=1
.S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM,""))
.;S ABM("DIAG")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2) ; CSV-c ;abm*2.6*14 updated API call
.S ABM("DIAG")=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2) ; CSV-c ;abm*2.6*14 updated API call
.S $P(ABMF(30),U)=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0)),U,6)=1:0,1:9) ;ICD indicator
.S $P(ABMF(ABM("ID")),U,ABM("TB"))=ABM("DIAG")
.S ABM("TB")=ABM("TB")+1
.I (ABM("TB")>4) D
..S ABM("TB")=1
..S ABM("ID")=ABM("ID")+1
.I ABM("ID")>33 S ABMDXQ=1 Q
.S ABMP("DX",ABM("DIAG"))=ABM("ID")-30
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,13)="N" D ;remove decimal from DX?
.F ABM("ID")=31:1:33 D
..Q:'$D(ABMF(ABM("ID")))
..S ABMF(ABM("ID"))=$TR(ABMF(ABM("ID")),".")
;
ST S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
S ABMPRINT=1 D ^ABMDESM1
;start new abm*2.6*22 IHS/SD/SDR HEAT335246
S ABMITMZ=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
I ((ABMITMZ)&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&($D(ABMP("FLAT")))) D
.I +$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16) S ABMS("I")=+$G(ABMS("I"))+1
.D ITEM^ABMDESM1
I $D(ABMP("FLAT")) D
.S ABMS("TOT")=+ABMP("FLAT") ;set total equal to flat rate
.K I
.S M=0
.S I=0
.F S I=$O(ABMS(I)) Q:'I D
..S M=+M+1
..I M=1 S $P(ABMS(I),U)=+ABMP("FLAT"),$P(ABMS(I),U,6)=1
..I M'=1 S $P(ABMS(I),U)=0,$P(ABMS(I),U,6)=0 ;zeros for all other lines
.K ABMP("FLAT")
;end new abm*2.6*22 IHS/SD/SDR HEAT335246
I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3" D
.S ABMI=0
.F S ABMI=$O(ABMS(ABMI)) Q:'ABMI D
..I $P($P(ABMS(ABMI),U,4),"-",2)="QL" S ABMQLFLG=1
..S ABMODMOD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
.S ABMI=0
.F S ABMI=$O(ABMS(ABMI)) Q:'ABMI D
..I $G(ABMQLFLG)=1,($P($P(ABMS(ABMI),U,4)," ",2)'="QL") S $P(ABMS(ABMI),U,4)=$P($P(ABMS(ABMI),U,4)," ")
..I $G(ABMQLFLG)'=1 S $P(ABMS(ABMI),U,4)=$P(ABMS(ABMI),U,4)_" "_ABMODMOD
K ABMQLFLG
HCFA ;
I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U)=0 S ABMS("TOT")=0
D EMG^ABMDF35E ;set EMG flag
S ABMS=0
F S ABMS=$O(ABMS(ABMS)) Q:+ABMS=0 D
.S ABMLN=2
.D PROC^ABMDF35E
.S ABMLN=ABMLN+1
S ABMLN=0,ABMPRT=0
F ABMS("I")=37:2:47 D Q:$G(ABM("QUIT"))
.S ABMLN=$O(ABMR(ABMLN))
.Q:+ABMLN=0
.S ABMPRT=0
.I (($O(ABMR(ABMLN,9),-1))+(ABMS("I")))>49 Q
.F S ABMPRT=$O(ABMR(ABMLN,ABMPRT)) Q:+ABMPRT=0 D
..M ABMF($S(ABMPRT=1:(ABMS("I")-1),1:ABMS("I")))=ABMR(ABMLN,ABMPRT)
..K ABMR(ABMLN,ABMPRT)
;
D PREV^ABMDFUTL
S ABM("RATIO")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2)/$S($P(^(2),U,3):$P(^(2),U,3),1:1)
S:ABM("RATIO")>1 ABM("RATIO")=1
S ABM("W")=+$FN(ABMP("WO")*ABM("RATIO"),"",2)
I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO" D
.S $P(ABMF(49),U,8)=+$FN(ABMP("PD")*ABM("RATIO"),"",2)+ABM("W")
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)'=0 S $P(ABMF(49),U,8)=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23) ;abm*2.6*13
S ABM("OB")=ABMS("TOT")-$P(ABMF(49),U,8)
S:ABM("OB")<0 ABM("OB")=0
S ABM("YTOT")=ABM("OB")
D YTOT^ABMDFUTL
S $P(ABMF(49),U,7)=ABMS("TOT") ; Total Charges
I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO" D
.S $P(ABMF(49),U,8)=+$FN(ABMP("PD"),"",2)
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)'=0 S $P(ABMF(49),U,8)=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23) ;abm*2.6*13
; Amount Due
K ABMS
I $D(ABMR) D
.S ABMR("TOT")=$P(ABMF(49),U,7,8)
.S $P(ABMF(49),U,7)="",$P(ABMF(49),U,8)=""
;
PRV ; Provider Info
I $P($G(^ABMDPARM(DUZ(2),1,0)),"^",17)=3 D G PDT
.S ABM("SIGN")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",7)
.I ABM("SIGN")="" D
..S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)) D
...Q:'ABM("X")
...D SELBILL^ABMDE4X
...S ABM("SIGN")=$P(ABM("A"),U,2)
.E D
..S ABM("A")=$P($G(^VA(200,+ABM("SIGN"),20)),"^",2)_"^"_+ABM("SIGN")
I $P($G(^ABMDPARM(DUZ(2),1,0)),U,17)=2 D G PDT
S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)) D
.Q:'ABM("X")
.D SELBILL^ABMDE4X
.S $P(ABMF(52),U)=$P($G(^VA(200,+$P(ABM("A"),"^",2),20)),"^",2)
.S:$P(ABMF(52),U)="" $P(ABMF(52),U)=$P(ABM("A"),U)
PDT ;
S $P(ABMF(54),U)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),$G(ABMP("PRINTDT"))="A":$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)
I $D(ABM("A")) D
.S ABM("PRO")=$P(ABM("A"),U,2)
.S $P(ABMF(54),U,4)=$S($P($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U)>0:$P($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U),1:"")
.S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
.S $P(ABMF(54),U,4)=$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)
.S ABMPQ=$S(ABMP("ITYPE")="R":"1C",ABMP("ITYPE")="D":"1D",$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
.S:$G(ABMPQ)="" ABMPQ="G2"
.S:($G(ABMP("NPIS"))'="")&($G(ABMP("NPIS"))'="N") $P(ABMF(54),U,5)=$G(ABMPQ)_$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
.I ($G(ABMP("NPIS"))'="")&($G(ABMP("NPIS"))'="N") S $P(ABMF(54),U,5)="ZZ"_$$PTAX^ABMEEPRV(ABM("PRO"))
I $P($G(^AUTNINS(ABMP("INS"),0)),U)["ALASKA MEDICAID" D
.Q:$P($G(ABMF(37)),U,3)'=22 ;only change for POS 22
.S $P(ABMF(54),U,4)="982808978",$P(ABMF(54),U,5)="1DCL461"
;
XIT K ABM,ABMV,ABMX,ABMPRINT
Q
ABMDF35D ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array - Part 4 ;
+1 ;;2.6;IHS Third Party Billing;**13,14,22**;NOV 12, 2009;Build 418
+2 ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
+3 ;IHS/SD/SDR 2.6*22 HEAT335246 check new parameter for itemized but with the flat rate on first line, zeros for the rest
+4 ;
+5 ; *********************************************************************
+6 ;
DX ; Diagnosis Info
+1 KILL ABMP("DX")
+2 SET ABM=""
+3 SET ABM("ID")=31
+4 SET ABM("TB")=1
+5 SET ABMDXQ=0
+6 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM))
IF 'ABM!(ABM>12)
QUIT
Begin DoDot:1
+7 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM,""))
+8 ;S ABM("DIAG")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2) ; CSV-c ;abm*2.6*14 updated API call
+9 ; CSV-c ;abm*2.6*14 updated API call
SET ABM("DIAG")=$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)
+10 ;ICD indicator
SET $PIECE(ABMF(30),U)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0)),U,6)=1:0,1:9)
+11 SET $PIECE(ABMF(ABM("ID")),U,ABM("TB"))=ABM("DIAG")
+12 SET ABM("TB")=ABM("TB")+1
+13 IF (ABM("TB")>4)
Begin DoDot:2
+14 SET ABM("TB")=1
+15 SET ABM("ID")=ABM("ID")+1
End DoDot:2
+16 IF ABM("ID")>33
SET ABMDXQ=1
QUIT
+17 SET ABMP("DX",ABM("DIAG"))=ABM("ID")-30
End DoDot:1
IF ABMDXQ=1
QUIT
+18 ;remove decimal from DX?
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),0)),U,13)="N"
Begin DoDot:1
+19 FOR ABM("ID")=31:1:33
Begin DoDot:2
+20 IF '$DATA(ABMF(ABM("ID")))
QUIT
+21 SET ABMF(ABM("ID"))=$TRANSLATE(ABMF(ABM("ID")),".")
End DoDot:2
End DoDot:1
+22 ;
ST SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+1 SET ABMPRINT=1
DO ^ABMDESM1
+2 ;start new abm*2.6*22 IHS/SD/SDR HEAT335246
+3 SET ABMITMZ=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",12)
+4 IF ((ABMITMZ)&($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&($DATA(ABMP("FLAT"))))
Begin DoDot:1
+5 IF +$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)
SET ABMS("I")=+$GET(ABMS("I"))+1
+6 DO ITEM^ABMDESM1
End DoDot:1
+7 IF $DATA(ABMP("FLAT"))
Begin DoDot:1
+8 ;set total equal to flat rate
SET ABMS("TOT")=+ABMP("FLAT")
+9 KILL I
+10 SET M=0
+11 SET I=0
+12 FOR
SET I=$ORDER(ABMS(I))
IF 'I
QUIT
Begin DoDot:2
+13 SET M=+M+1
+14 IF M=1
SET $PIECE(ABMS(I),U)=+ABMP("FLAT")
SET $PIECE(ABMS(I),U,6)=1
+15 ;zeros for all other lines
IF M'=1
SET $PIECE(ABMS(I),U)=0
SET $PIECE(ABMS(I),U,6)=0
End DoDot:2
+16 KILL ABMP("FLAT")
End DoDot:1
+17 ;end new abm*2.6*22 IHS/SD/SDR HEAT335246
+18 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3"
Begin DoDot:1
+19 SET ABMI=0
+20 FOR
SET ABMI=$ORDER(ABMS(ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+21 IF $PIECE($PIECE(ABMS(ABMI),U,4),"-",2)="QL"
SET ABMQLFLG=1
+22 SET ABMODMOD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
End DoDot:2
+23 SET ABMI=0
+24 FOR
SET ABMI=$ORDER(ABMS(ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+25 IF $GET(ABMQLFLG)=1
IF ($PIECE($PIECE(ABMS(ABMI),U,4)," ",2)'="QL")
SET $PIECE(ABMS(ABMI),U,4)=$PIECE($PIECE(ABMS(ABMI),U,4)," ")
+26 IF $GET(ABMQLFLG)'=1
SET $PIECE(ABMS(ABMI),U,4)=$PIECE(ABMS(ABMI),U,4)_" "_ABMODMOD
End DoDot:2
End DoDot:1
+27 KILL ABMQLFLG
HCFA ;
+1 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U)=0
SET ABMS("TOT")=0
+2 ;set EMG flag
DO EMG^ABMDF35E
+3 SET ABMS=0
+4 FOR
SET ABMS=$ORDER(ABMS(ABMS))
IF +ABMS=0
QUIT
Begin DoDot:1
+5 SET ABMLN=2
+6 DO PROC^ABMDF35E
+7 SET ABMLN=ABMLN+1
End DoDot:1
+8 SET ABMLN=0
SET ABMPRT=0
+9 FOR ABMS("I")=37:2:47
Begin DoDot:1
+10 SET ABMLN=$ORDER(ABMR(ABMLN))
+11 IF +ABMLN=0
QUIT
+12 SET ABMPRT=0
+13 IF (($ORDER(ABMR(ABMLN,9),-1))+(ABMS("I")))>49
QUIT
+14 FOR
SET ABMPRT=$ORDER(ABMR(ABMLN,ABMPRT))
IF +ABMPRT=0
QUIT
Begin DoDot:2
+15 MERGE ABMF($SELECT(ABMPRT=1:(ABMS("I")-1),1:ABMS("I")))=ABMR(ABMLN,ABMPRT)
+16 KILL ABMR(ABMLN,ABMPRT)
End DoDot:2
End DoDot:1
IF $GET(ABM("QUIT"))
QUIT
+17 ;
+18 DO PREV^ABMDFUTL
+19 SET ABM("RATIO")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2)/$SELECT($PIECE(^(2),U,3):$PIECE(^(2),U,3),1:1)
+20 IF ABM("RATIO")>1
SET ABM("RATIO")=1
+21 SET ABM("W")=+$FNUMBER(ABMP("WO")*ABM("RATIO"),"",2)
+22 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO"
Begin DoDot:1
+23 SET $PIECE(ABMF(49),U,8)=+$FNUMBER(ABMP("PD")*ABM("RATIO"),"",2)+ABM("W")
+24 ;abm*2.6*13
IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)'=0
SET $PIECE(ABMF(49),U,8)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)
End DoDot:1
+25 SET ABM("OB")=ABMS("TOT")-$PIECE(ABMF(49),U,8)
+26 IF ABM("OB")<0
SET ABM("OB")=0
+27 SET ABM("YTOT")=ABM("OB")
+28 DO YTOT^ABMDFUTL
+29 ; Total Charges
SET $PIECE(ABMF(49),U,7)=ABMS("TOT")
+30 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,17)="DO"
Begin DoDot:1
+31 SET $PIECE(ABMF(49),U,8)=+$FNUMBER(ABMP("PD"),"",2)
+32 ;abm*2.6*13
IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)'=0
SET $PIECE(ABMF(49),U,8)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,23)
End DoDot:1
+33 ; Amount Due
+34 KILL ABMS
+35 IF $DATA(ABMR)
Begin DoDot:1
+36 SET ABMR("TOT")=$PIECE(ABMF(49),U,7,8)
+37 SET $PIECE(ABMF(49),U,7)=""
SET $PIECE(ABMF(49),U,8)=""
End DoDot:1
+38 ;
PRV ; Provider Info
+1 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),"^",17)=3
Begin DoDot:1
+2 SET ABM("SIGN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",7)
+3 IF ABM("SIGN")=""
Begin DoDot:2
+4 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
Begin DoDot:3
+5 IF 'ABM("X")
QUIT
+6 DO SELBILL^ABMDE4X
+7 SET ABM("SIGN")=$PIECE(ABM("A"),U,2)
End DoDot:3
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 SET ABM("A")=$PIECE($GET(^VA(200,+ABM("SIGN"),20)),"^",2)_"^"_+ABM("SIGN")
End DoDot:2
End DoDot:1
GOTO PDT
+10 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,17)=2
Begin DoDot:1
End DoDot:1
GOTO PDT
+11 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
Begin DoDot:1
+12 IF 'ABM("X")
QUIT
+13 DO SELBILL^ABMDE4X
+14 SET $PIECE(ABMF(52),U)=$PIECE($GET(^VA(200,+$PIECE(ABM("A"),"^",2),20)),"^",2)
+15 IF $PIECE(ABMF(52),U)=""
SET $PIECE(ABMF(52),U)=$PIECE(ABM("A"),U)
End DoDot:1
PDT ;
+1 SET $PIECE(ABMF(54),U)=$SELECT($GET(ABMP("PRINTDT"))="O":$PIECE($GET(^ABMDTXST(DUZ(2),+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),$GET(ABMP("PRINTDT"))="A":$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)
+2 IF $DATA(ABM("A"))
Begin DoDot:1
+3 SET ABM("PRO")=$PIECE(ABM("A"),U,2)
+4 SET $PIECE(ABMF(54),U,4)=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",ABM("PRO")),U),1:"")
+5 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...
... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
+6 SET $PIECE(ABMF(54),U,4)=$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)
+7 SET ABMPQ=$SELECT(ABMP("ITYPE")="R":"1C",ABMP("ITYPE")="D":"1D",$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"
0B")
+8 IF $GET(ABMPQ)=""
SET ABMPQ="G2"
+9 IF ($GET(ABMP("NPIS"))'="")&($GET(ABMP("NPIS"))'="N")
SET $PIECE(ABMF(54),U,5)=$GET(ABMPQ)_$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,8)
+10 IF ($GET(ABMP("NPIS"))'="")&($GET(ABMP("NPIS"))'="N")
SET $PIECE(ABMF(54),U,5)="ZZ"_$$PTAX^ABMEEPRV(ABM("PRO"))
End DoDot:1
+11 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["ALASKA MEDICAID"
Begin DoDot:1
+12 ;only change for POS 22
IF $PIECE($GET(ABMF(37)),U,3)'=22
QUIT
+13 SET $PIECE(ABMF(54),U,4)="982808978"
SET $PIECE(ABMF(54),U,5)="1DCL461"
End DoDot:1
+14 ;
XIT KILL ABM,ABMV,ABMX,ABMPRINT
+1 QUIT
