ABMDVS12.m

ABMDVS12 ; IHS/ASDST/DMJ - PCC VISIT STUFF, PHYSICAL THERAPY ; 

 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 ;Original;RAM;03/26/96 10:50 AM

 ;This rtn may not be needed anymore.  13 may do it OK.

 ;As things stand this does not seem to do anything that is not done

 ;better by rtn 13.  If for some reason it is needed the source field 

 ;needs to be added.

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI

 ;

 Q

 Q:ABMIDONE

START ;START HERE

 K AMB12

 S AMB12("DA")=0 F  S AMB12("DA")=$O(^AUPNVPT("AD",ABMVDFN,AMB12("DA"))) Q:'AMB12("DA")  D

 .S AMB12("CPT")=$$CPT(AMB12("DA")) Q:AMB12("CPT")=""

 .Q:'$D(^ICPT("B",AMB12("CPT")))

 .S AMB12("CPT",AMB12("CPT"))=""

 .;Q:(('$P($G(^ABMDFEE(+ABMP("FEE"),15,AMB12("CPT"),0)),"^",2))&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A

 .Q:(('$P($$ONE^ABMFEAPI(+ABMP("FEE"),15,AMB12("CPT"),ABMP("VDT")),"^"))&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A

 .;S AMB12("CHRG",AMB12("CPT"))=$P($G(^ABMDFEE(+ABMP("FEE"),15,AMB12("CPT"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 .S AMB12("CHRG",AMB12("CPT"))=$P($$ONE^ABMFEAPI(+ABMP("FEE"),15,AMB12("CPT"),ABMP("VDT")),"^")  ;abm*2.6*2 3PMS10003A

 .S AMB12("UNITS",AMB12("CPT"))=+$G(AMB12("UNITS",AMB12("CPT")))+1

 I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)) S ^(0)="^9002274.3027P^^"

 S AMB12("CPT")=0 F  S AMB12("CPT")=$O(AMB12("CPT",AMB12("CPT"))) Q:'AMB12("CPT")  D

 .S X=AMB12("CPT"),DIC="^ABMDCLM("_DUZ(2)_","_ABMP("CDFN")_",27,",DIC(0)="LXE" D ^DIC Q:Y<0

 .S AMB12("RVN")=$P($$IHSCPT^ABMCVAPI(+AMB12("CPT"),ABMP("VDT")),U,3)  ;CSV-c

 .S DIE=DIC,DA(1)=ABMP("CDFN"),DA=AMB12("CPT"),DR=".02///"_AMB12("RVN")_";.03///"_AMB12("UNITS",AMB12("CPT"))_";.04///"_AMB12("CHRG",AMB12("CPT")) D ^DIE

 K AMB12 Q

 ;

CPT(X) ; -- cpt code

 Q $P($$CPT^ABMCVAPI(+$P($G(^AUTTPHTH(+$G(^AUPNVPT(+X,0)),0)),U,2),ABMP("VDT")),U,2)  ;CSV-c

ABMDVS12  ; IHS/ASDST/DMJ - PCC VISIT STUFF, PHYSICAL THERAPY ; 

 +1       ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 +2       ;Original;RAM;03/26/96 10:50 AM

 +3       ;This rtn may not be needed anymore.  13 may do it OK.

 +4       ;As things stand this does not seem to do anything that is not done

 +5       ;better by rtn 13.  If for some reason it is needed the source field 

 +6       ;needs to be added.

 +7       ;

 +8       ; IHS/SD/SDR - v2.6 CSV

 +9       ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI

 +10      ;

 +11       QUIT 

 +12       IF ABMIDONE

               QUIT 

START     ;START HERE

 +1        KILL AMB12

 +2        SET AMB12("DA")=0

           FOR 

               SET AMB12("DA")=$ORDER(^AUPNVPT("AD",ABMVDFN,AMB12("DA")))

               IF 'AMB12("DA")

                   QUIT 

               Begin DoDot:1

 +3                SET AMB12("CPT")=$$CPT(AMB12("DA"))

                   IF AMB12("CPT")=""

                       QUIT 

 +4                IF '$DATA(^ICPT("B",AMB12("CPT")))

                       QUIT 

 +5                SET AMB12("CPT",AMB12("CPT"))=""

 +6       ;Q:(('$P($G(^ABMDFEE(+ABMP("FEE"),15,AMB12("CPT"),0)),"^",2))&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A

 +7       ;abm*2.6*2 3PMS10003A

                   IF (('$PIECE($$ONE^ABMFEAPI(+ABMP("FEE"),15,AMB12("CPT"),ABMP("VDT")),"^"))&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))

                       QUIT 

 +8       ;S AMB12("CHRG",AMB12("CPT"))=$P($G(^ABMDFEE(+ABMP("FEE"),15,AMB12("CPT"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 +9       ;abm*2.6*2 3PMS10003A

                   SET AMB12("CHRG",AMB12("CPT"))=$PIECE($$ONE^ABMFEAPI(+ABMP("FEE"),15,AMB12("CPT"),ABMP("VDT")),"^")

 +10               SET AMB12("UNITS",AMB12("CPT"))=+$GET(AMB12("UNITS",AMB12("CPT")))+1

               End DoDot:1

 +11       IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0))

               SET ^(0)="^9002274.3027P^^"

 +12       SET AMB12("CPT")=0

           FOR 

               SET AMB12("CPT")=$ORDER(AMB12("CPT",AMB12("CPT")))

               IF 'AMB12("CPT")

                   QUIT 

               Begin DoDot:1

 +13               SET X=AMB12("CPT")

                   SET DIC="^ABMDCLM("_DUZ(2)_","_ABMP("CDFN")_",27,"

                   SET DIC(0)="LXE"

                   DO ^DIC

                   IF Y<0

                       QUIT 

 +14      ;CSV-c

                   SET AMB12("RVN")=$PIECE($$IHSCPT^ABMCVAPI(+AMB12("CPT"),ABMP("VDT")),U,3)

 +15               SET DIE=DIC

                   SET DA(1)=ABMP("CDFN")

                   SET DA=AMB12("CPT")

                   SET DR=".02///"_AMB12("RVN")_";.03///"_AMB12("UNITS",AMB12("CPT"))_";.04///"_AMB12("CHRG",AMB12("CPT"))

                   DO ^DIE

               End DoDot:1

 +16       KILL AMB12

           QUIT 

 +17      ;

CPT(X)    ; -- cpt code

 +1       ;CSV-c

           QUIT $PIECE($$CPT^ABMCVAPI(+$PIECE($GET(^AUTTPHTH(+$GET(^AUPNVPT(+X,0)),0)),U,2),ABMP("VDT")),U,2)