ABMDF35D.m

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