ABMDE31 ;IHS/SD/SDR - AMBULANCE - PAGE 3A ;
;;2.6;IHS 3P BILLING SYSTEM;**6**;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p8 - task 6 - New routine for page 3A
; IHS/SD/SDR - abm*2.6*6 - 5010 - added patient count
;
;
OPT ;EP
G XIT:$D(ABMP("WORKSHEET"))
K ABM,ABME,ABMZ,DUOUT,ABMP("QU")
S ABMP("OPT")="ENVJBQ"
D DISP
G XIT:$D(DTOUT)!$D(DIROUT)
D ^ABMDE31X
I +$O(ABME(0)) D
. S ABME("CONT")=""
. D ^ABMDERR
. K ABME("CONT")
G XIT:$D(DTOUT)!$D(DIROUT)
W !
D SEL^ABMDEOPT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!("EV"'[$E(Y))
S ABM("DO")=$S($E(Y)="E":"E1",1:"V1")
W !
D @ABM("DO")
G XIT:$D(DTOUT)!$D(DIROUT)
G OPT
V1 ;View data
S ABMZ("TITL")="AMBULANCE QUESTIONS - VIEW OPTION"
D SUM^ABMDE1
D ^ABMDERR
Q
E1 ;Edit data
;S ABMP("FLDS")=10 ;abm*2.6*6 5010
S ABMP("FLDS")=11 ;abm*2.6*6 5010
D FLDS^ABMDEOPT
W !
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S DR=""
F ABM("I")=1:1 S ABM=$P(ABMP("FLDS"),",",ABM("I")) Q:ABM="" D
.Q:$P(ABMP("FLDS"),",",ABM("I"))=3
.S:ABM("I")>1 DR=DR_";"
.S DR=DR_$P($T(@ABM),";;",2)
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D ^DIE
; other fields for Point of Pickup (1)
I ABMP("FLDS")=1!(ABMP("FLDS")["1,") D
.K DIE,DA,DR,DIC,X,Y
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".122R//PATIENT'S HOME"
.D ^DIE
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,2)'="PATIENT'S HOME" S DR=".123:.126;.1214"
.E S DR=".123///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U);.124///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,4);.125///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,5);.126///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,6);.1214"
.D ^DIE
.D VALSTUFF ;stuff zip code with A0 as value code on 9D
;destination (3)
I ABMP("FLDS")[3 D
.K DIR,DIC,DIE,DR,DA,X
.S DA=ABMP("CDFN")
.S DIE="^ABMDCLM("_DUZ(2)_","
.S DIC("V")="Q:X'=""PATIENT'S HOME"" I X=""PATIENT'S HOME"" S X=$P($G(^DPT(ABMP(""PDFN""),0)),U) I +Y(0)=9000001 K DIC(""V"")"
.S ABMDVAR=$P($G(^DIC(4,DUZ(2),0)),U)
.S DR=".127//^S X=ABMDVAR;.1216Destination Modifier"
.D ^DIE
;
I ABMP("FLDS")[5 D
.K DIR,DIC,DIE,DR,DA,DIR
.S DA=ABMP("CDFN")
.S DR=.128
.S DIE="^ABMDCLM("_DUZ(2)_","
.D ^DIE
.K DIR,DIC,DIE,DR,DA,DIR
I ABMP("FLDS")[6 D
.K DIR,DIC,DIE,DR,DA,DIR
.S DA=ABMP("CDFN")
.S DR=.129
.S DIE="^ABMDCLM("_DUZ(2)_","
.D ^DIE
.K DIR,DIC,DIE,DR,DA,DIR
;other fields for medical necessity ind (5)
I ABMP("FLDS")[7 D
.S ABMANS=X
.I ABMANS="Y" D
..F D Q:(+$G(Y)<1)!$D(DUOUT)!$D(DTOUT)
...K DIC
...S DA(1)=ABMP("CDFN")
...S ABMENTRY=+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,0)),U,4)
...S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
...S DIC(0)=$S(ABMENTRY=5:"AEMQ",1:"AELMQ")
...I ABMENTRY'=0 S DIC("A")=$S(ABMENTRY=1:"2nd ",ABMENTRY=2:"3rd ",ABMENTRY=3:"4th ",ABMENTRY=4:"5th ",1:"")
...S DIC("P")=$P(^DD(9002274.3,14,0),U,2)
...S DIC("A")=$G(DIC("A"))_"Condition indicator (reason): "
...K DD,DO
...D ^DIC
...I (+$G(Y)>0),$P(Y,U,3)="" D
....S DIE=DIC
....S DA=+Y
....S DR=".01Condition indicator//"
....D ^DIE
.I ABMANS="N" D ;make sure no condition indicators if no
..S DA(1)=ABMP("CDFN")
..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
..S ABMIEN=0
..F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMIEN)) Q:ABMIEN="" D
...S DA=ABMIEN
...D ^DIK
;
K DR
Q
DISP ;
S ABMZ("TITL")="AMBULANCE QUESTIONS"
S ABMZ("PG")="3A"
I $D(ABMP("DDL")),$Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) I 1
E D SUM^ABMDE1
;
S ABMAREC=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12))
W !?3,"[01] Point of Pickup........: ",$P(ABMAREC,U,2) ;origin
W !?33,$P(ABMAREC,U,3) ;origin address
W !?33,$S($P(ABMAREC,U,4)'="":$P(ABMAREC,U,4),1:"") ;origin city
W $S($P(ABMAREC,U,5)'="":", "_$P($G(^DIC(5,$P(ABMAREC,U,5),0)),U),1:"") ;origin state
W $S($P(ABMAREC,U,6)'="":" "_$P(ABMAREC,U,6),1:"") ;origin zip
W !,?8,"[02] Modifier.........: ",$P(ABMAREC,U,14)_" "_$S($P(ABMAREC,U,14)'="":$P($P($P(^DD(9002274.3,.1214,0),U,3),$P(ABMAREC,U,14)_":",2),";"),1:"") ;modifier
;
S ABMDIEN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,7)
S ABMDREC=$$GETDEST(ABMDIEN) ;variable pointer; get data
W !?3,"[03] Destination............: ",$P(ABMDREC,U) ;destination
W !?33,$P(ABMDREC,U,2) ;destination address
W !?33,$P(ABMDREC,U,3) ;destination city
W $S($P(ABMDREC,U,4)'="":", "_$P(ABMDREC,U,4),1:"")
W $S($P(ABMDREC,U,5)'="":" "_$P(ABMDREC,U,5),1:"") ;destination state/zip
W !,?8,"[04] Modifier.........: ",$P(ABMAREC,U,16)_" "_$S($P(ABMAREC,U,16)'="":$P($P($P(^DD(9002274.3,.1216,0),U,3),$P(ABMAREC,U,16)_":",2),";"),1:"") ;modifier
;
W !
W !?3,"[05] Mileage (Covered)......: ",$P(ABMAREC,U,8)
W !?3,"[06] Mileage (Non-Covered)..: ",$P(ABMAREC,U,9)
;
W !?3,"[07] Medical Necessity Ind..: ",$P(ABMAREC,U,15)
S ABMCONDI=0
F S ABMCONDI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI)) Q:+ABMCONDI=0 D
.S ABMCOND=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI,0)),U)
.W !?9,"Condition Indicator...: ",$P($G(^ABMCNDIN(ABMCOND,0)),U)_" "_$E($P($G(^ABMCNDIN(ABMCOND,0)),U,2),1,43)
;
W !?3,"[08] Patient Weight (lbs)...: ",$P(ABMAREC,U,11)
W !?3,"[09] Patient Count..........: ",$P(ABMAREC,U,18) ;abm*2.6*6 5010
W !
W !,"Transfers Only:"
S ABMTRNST=$P(ABMAREC,U,12)
S:ABMTRNST'="" ABMTRNST=$S(ABMTRNST="I":"INITIAL TRIP",ABMTRNST="R":"RETURN TRIP",ABMTRNST="T":"TRANSFER TRIP",1:"ROUND TRIP")
;start old code abm*2.6*6 5010
;W !?3,"[09] Type of Transport......: ",ABMTRNST
;W !?3,"[10] Transported To/For.....: "
;I $P(ABMAREC,U,13)'="" W $P($T(@($P(ABMAREC,U,13))),";;",2)
;end old code start new code 5010
W !?3,"[10] Type of Transport......: ",ABMTRNST
W !?3,"[11] Transported To/For.....: "
I $P(ABMAREC,U,13)'="" W $P($T(@($P(ABMAREC,U,13))),";;",2)
;end new code 5010
W !
K ABMAREC
Q
XIT ;
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
K ABM,ABMV,ABME
Q
GETDEST(ABMDIEN) ;EP - figure out data for destination - variable pointer
I $G(ABMDIEN)="" S ABMDREC="" Q ""
I $P(ABMDIEN,";",2)["AUPNPAT" D Q ABMDREC
.S ABMDREC="PATIENT'S HOME"
.S $P(ABMDREC,U,2)=$P($G(^DPT(+ABMDIEN,.11)),U) ;pt street
.S $P(ABMDREC,U,3)=$P($G(^DPT(+ABMDIEN,.11)),U,4) ;pt city
.S $P(ABMDREC,U,4)=$S($P($G(^DPT(+ABMDIEN,.11)),U,5):$P($G(^DIC(5,$P(^DPT(+ABMDIEN,.11),U,5),0)),U),1:"") ;pt state
.S $P(ABMDREC,U,5)=$P($G(^DPT(+ABMDIEN,.11)),U,6) ;pt zip
;
I $P(ABMDIEN,";",2)["AUTTLOC" D Q ABMDREC
.S ABMDREC=$P($G(^AUTTLOC(+ABMDIEN,0)),U) ;loc name
.S:$G(ABMDREC)'="" ABMDREC=$P($G(^DIC(4,ABMDREC,0)),U)
.S $P(ABMDREC,U,2)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,12) ;loc street
.S $P(ABMDREC,U,3)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,13) ;loc city
.S $P(ABMDREC,U,4)=$S($P($G(^AUTTLOC(+ABMDIEN,0)),U,14):$P($G(^DIC(5,$P(^AUTTLOC(+ABMDIEN,0),U,14),0)),U),1:"") ;loc state
.S $P(ABMDREC,U,5)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,15) ;loc zip
;
I $P(ABMDIEN,";",2)["AUTTVNDR" D Q ABMDREC
.S ABMDREC=$P($G(^AUTTVNDR(+ABMDIEN,0)),U) ;vndr name
.S $P(ABMDREC,U,2)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U) ;vndr street
.S $P(ABMDREC,U,3)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U,2) ;vndr city
.S $P(ABMDREC,U,4)=$S($P($G(^AUTTVNDR(+ABMDIEN,13)),U,3):$P($G(^DIC(5,$P(^AUTTVNDR(+ABMDIEN,13),U,3),0)),U),1:"") ;vndr state
.S $P(ABMDREC,U,5)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U,4) ;vndr zip
Q ABMDREC
VALSTUFF ;
K DA,DA(1),DIC,DR,DIR
S DA(1)=ABMP("CDFN")
S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
S DIC(0)="LM"
S DIC("P")=$P(^DD(9002274.3,55,0),U,2)
S X="A0"
K DD,DO
D ^DIC
Q:+Y<0
K DA,DA(1),DR,DIC,DIR
S DA=+Y
S DA(1)=ABMP("CDFN")
S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
S DR=".02////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,6)
D ^DIE
Q
; Entry of Claim Identifiers
2 ;;.1214 Point of Pickup Modifier
4 ;;.1216 Destination Modifier
7 ;;.1215 Was ambulance transport considered MEDICALLY NECESSARY?
8 ;;.1211
;; abm*2.6*6 5010 moved 9 to 10; 10 to 11; added new 9 for pt count
9 ;;1218
10 ;;.1212
11 ;;.1213
;
;transported to/for descriptions
A ;;NEAREST FAC.-CARE OF SYMPTOMS/COMPLAINTS/BOTH
B ;;BENEFIT OF PREFERRED PHYSICIAN
C ;;NEARNESS OF FAMILY MEMBERS
D ;;A SPECIALIST/AVAILABILITY OF SPECIALIZED EQUIP
E ;;TRANSFERRED TO REHAB FACILITY
ABMDE31 ;IHS/SD/SDR - AMBULANCE - PAGE 3A ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p8 - task 6 - New routine for page 3A
+4 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added patient count
+5 ;
+6 ;
OPT ;EP
+1 IF $DATA(ABMP("WORKSHEET"))
GOTO XIT
+2 KILL ABM,ABME,ABMZ,DUOUT,ABMP("QU")
+3 SET ABMP("OPT")="ENVJBQ"
+4 DO DISP
+5 IF $DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+6 DO ^ABMDE31X
+7 IF +$ORDER(ABME(0))
Begin DoDot:1
+8 SET ABME("CONT")=""
+9 DO ^ABMDERR
+10 KILL ABME("CONT")
End DoDot:1
+11 IF $DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+12 WRITE !
+13 DO SEL^ABMDEOPT
+14 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!("EV"'[$EXTRACT(Y))
GOTO XIT
+15 SET ABM("DO")=$SELECT($EXTRACT(Y)="E":"E1",1:"V1")
+16 WRITE !
+17 DO @ABM("DO")
+18 IF $DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+19 GOTO OPT
V1 ;View data
+1 SET ABMZ("TITL")="AMBULANCE QUESTIONS - VIEW OPTION"
+2 DO SUM^ABMDE1
+3 DO ^ABMDERR
+4 QUIT
E1 ;Edit data
+1 ;S ABMP("FLDS")=10 ;abm*2.6*6 5010
+2 ;abm*2.6*6 5010
SET ABMP("FLDS")=11
+3 DO FLDS^ABMDEOPT
+4 WRITE !
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+6 SET DR=""
+7 FOR ABM("I")=1:1
SET ABM=$PIECE(ABMP("FLDS"),",",ABM("I"))
IF ABM=""
QUIT
Begin DoDot:1
+8 IF $PIECE(ABMP("FLDS"),",",ABM("I"))=3
QUIT
+9 IF ABM("I")>1
SET DR=DR_";"
+10 SET DR=DR_$PIECE($TEXT(@ABM),";;",2)
End DoDot:1
+11 SET DIE="^ABMDCLM(DUZ(2),"
+12 SET DA=ABMP("CDFN")
+13 DO ^DIE
+14 ; other fields for Point of Pickup (1)
+15 IF ABMP("FLDS")=1!(ABMP("FLDS")["1,")
Begin DoDot:1
+16 KILL DIE,DA,DR,DIC,X,Y
+17 SET DIE="^ABMDCLM(DUZ(2),"
+18 SET DA=ABMP("CDFN")
+19 SET DR=".122R//PATIENT'S HOME"
+20 DO ^DIE
+21 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,2)'="PATIENT'S HOME"
SET DR=".123:.126;.1214"
+22 IF '$TEST
SET DR=".123///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U);.124///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,4);.125///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,5);.126///^S X=$P($G(^DPT(ABMP(""PDFN""),.11)),U,6);.1214"
+23 DO ^DIE
+24 ;stuff zip code with A0 as value code on 9D
DO VALSTUFF
End DoDot:1
+25 ;destination (3)
+26 IF ABMP("FLDS")[3
Begin DoDot:1
+27 KILL DIR,DIC,DIE,DR,DA,X
+28 SET DA=ABMP("CDFN")
+29 SET DIE="^ABMDCLM("_DUZ(2)_","
+30 SET DIC("V")="Q:X'=""PATIENT'S HOME"" I X=""PATIENT'S HOME"" S X=$P($G(^DPT(ABMP(""PDFN""),0)),U) I +Y(0)=9000001 K DIC(""V"")"
+31 SET ABMDVAR=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+32 SET DR=".127//^S X=ABMDVAR;.1216Destination Modifier"
+33 DO ^DIE
End DoDot:1
+34 ;
+35 IF ABMP("FLDS")[5
Begin DoDot:1
+36 KILL DIR,DIC,DIE,DR,DA,DIR
+37 SET DA=ABMP("CDFN")
+38 SET DR=.128
+39 SET DIE="^ABMDCLM("_DUZ(2)_","
+40 DO ^DIE
+41 KILL DIR,DIC,DIE,DR,DA,DIR
End DoDot:1
+42 IF ABMP("FLDS")[6
Begin DoDot:1
+43 KILL DIR,DIC,DIE,DR,DA,DIR
+44 SET DA=ABMP("CDFN")
+45 SET DR=.129
+46 SET DIE="^ABMDCLM("_DUZ(2)_","
+47 DO ^DIE
+48 KILL DIR,DIC,DIE,DR,DA,DIR
End DoDot:1
+49 ;other fields for medical necessity ind (5)
+50 IF ABMP("FLDS")[7
Begin DoDot:1
+51 SET ABMANS=X
+52 IF ABMANS="Y"
Begin DoDot:2
+53 FOR
Begin DoDot:3
+54 KILL DIC
+55 SET DA(1)=ABMP("CDFN")
+56 SET ABMENTRY=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,0)),U,4)
+57 SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
+58 SET DIC(0)=$SELECT(ABMENTRY=5:"AEMQ",1:"AELMQ")
+59 IF ABMENTRY'=0
SET DIC("A")=$SELECT(ABMENTRY=1:"2nd ",ABMENTRY=2:"3rd ",ABMENTRY=3:"4th ",ABMENTRY=4:"5th ",1:"")
+60 SET DIC("P")=$PIECE(^DD(9002274.3,14,0),U,2)
+61 SET DIC("A")=$GET(DIC("A"))_"Condition indicator (reason): "
+62 KILL DD,DO
+63 DO ^DIC
+64 IF (+$GET(Y)>0)
IF $PIECE(Y,U,3)=""
Begin DoDot:4
+65 SET DIE=DIC
+66 SET DA=+Y
+67 SET DR=".01Condition indicator//"
+68 DO ^DIE
End DoDot:4
End DoDot:3
IF (+$GET(Y)<1)!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
End DoDot:2
+69 ;make sure no condition indicators if no
IF ABMANS="N"
Begin DoDot:2
+70 SET DA(1)=ABMP("CDFN")
+71 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
+72 SET ABMIEN=0
+73 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMIEN))
IF ABMIEN=""
QUIT
Begin DoDot:3
+74 SET DA=ABMIEN
+75 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+76 ;
+77 KILL DR
+78 QUIT
DISP ;
+1 SET ABMZ("TITL")="AMBULANCE QUESTIONS"
+2 SET ABMZ("PG")="3A"
+3 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-6)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
IF 1
+4 IF '$TEST
DO SUM^ABMDE1
+5 ;
+6 SET ABMAREC=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12))
+7 ;origin
WRITE !?3,"[01] Point of Pickup........: ",$PIECE(ABMAREC,U,2)
+8 ;origin address
WRITE !?33,$PIECE(ABMAREC,U,3)
+9 ;origin city
WRITE !?33,$SELECT($PIECE(ABMAREC,U,4)'="":$PIECE(ABMAREC,U,4),1:"")
+10 ;origin state
WRITE $SELECT($PIECE(ABMAREC,U,5)'="":", "_$PIECE($GET(^DIC(5,$PIECE(ABMAREC,U,5),0)),U),1:"")
+11 ;origin zip
WRITE $SELECT($PIECE(ABMAREC,U,6)'="":" "_$PIECE(ABMAREC,U,6),1:"")
+12 ;modifier
WRITE !,?8,"[02] Modifier.........: ",$PIECE(ABMAREC,U,14)_" "_$SELECT($PIECE(ABMAREC,U,14)'="":$PIECE($PIECE($PIECE(^DD(9002274.3,.1214,0),U,3),$PIECE(ABMAREC,U,14)_":",2),";"),1:"")
+13 ;
+14 SET ABMDIEN=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,7)
+15 ;variable pointer; get data
SET ABMDREC=$$GETDEST(ABMDIEN)
+16 ;destination
WRITE !?3,"[03] Destination............: ",$PIECE(ABMDREC,U)
+17 ;destination address
WRITE !?33,$PIECE(ABMDREC,U,2)
+18 ;destination city
WRITE !?33,$PIECE(ABMDREC,U,3)
+19 WRITE $SELECT($PIECE(ABMDREC,U,4)'="":", "_$PIECE(ABMDREC,U,4),1:"")
+20 ;destination state/zip
WRITE $SELECT($PIECE(ABMDREC,U,5)'="":" "_$PIECE(ABMDREC,U,5),1:"")
+21 ;modifier
WRITE !,?8,"[04] Modifier.........: ",$PIECE(ABMAREC,U,16)_" "_$SELECT($PIECE(ABMAREC,U,16)'="":$PIECE($PIECE($PIECE(^DD(9002274.3,.1216,0),U,3),$PIECE(ABMAREC,U,16)_":",2),";"),1:"")
+22 ;
+23 WRITE !
+24 WRITE !?3,"[05] Mileage (Covered)......: ",$PIECE(ABMAREC,U,8)
+25 WRITE !?3,"[06] Mileage (Non-Covered)..: ",$PIECE(ABMAREC,U,9)
+26 ;
+27 WRITE !?3,"[07] Medical Necessity Ind..: ",$PIECE(ABMAREC,U,15)
+28 SET ABMCONDI=0
+29 FOR
SET ABMCONDI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI))
IF +ABMCONDI=0
QUIT
Begin DoDot:1
+30 SET ABMCOND=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI,0)),U)
+31 WRITE !?9,"Condition Indicator...: ",$PIECE($GET(^ABMCNDIN(ABMCOND,0)),U)_" "_$EXTRACT($PIECE($GET(^ABMCNDIN(ABMCOND,0)),U,2),1,43)
End DoDot:1
+32 ;
+33 WRITE !?3,"[08] Patient Weight (lbs)...: ",$PIECE(ABMAREC,U,11)
+34 ;abm*2.6*6 5010
WRITE !?3,"[09] Patient Count..........: ",$PIECE(ABMAREC,U,18)
+35 WRITE !
+36 WRITE !,"Transfers Only:"
+37 SET ABMTRNST=$PIECE(ABMAREC,U,12)
+38 IF ABMTRNST'=""
SET ABMTRNST=$SELECT(ABMTRNST="I":"INITIAL TRIP",ABMTRNST="R":"RETURN TRIP",ABMTRNST="T":"TRANSFER TRIP",1:"ROUND TRIP")
+39 ;start old code abm*2.6*6 5010
+40 ;W !?3,"[09] Type of Transport......: ",ABMTRNST
+41 ;W !?3,"[10] Transported To/For.....: "
+42 ;I $P(ABMAREC,U,13)'="" W $P($T(@($P(ABMAREC,U,13))),";;",2)
+43 ;end old code start new code 5010
+44 WRITE !?3,"[10] Type of Transport......: ",ABMTRNST
+45 WRITE !?3,"[11] Transported To/For.....: "
+46 IF $PIECE(ABMAREC,U,13)'=""
WRITE $PIECE($TEXT(@($PIECE(ABMAREC,U,13))),";;",2)
+47 ;end new code 5010
+48 WRITE !
+49 KILL ABMAREC
+50 QUIT
XIT ;
+1 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+2 KILL ABM,ABMV,ABME
+3 QUIT
GETDEST(ABMDIEN) ;EP - figure out data for destination - variable pointer
+1 IF $GET(ABMDIEN)=""
SET ABMDREC=""
QUIT ""
+2 IF $PIECE(ABMDIEN,";",2)["AUPNPAT"
Begin DoDot:1
+3 SET ABMDREC="PATIENT'S HOME"
+4 ;pt street
SET $PIECE(ABMDREC,U,2)=$PIECE($GET(^DPT(+ABMDIEN,.11)),U)
+5 ;pt city
SET $PIECE(ABMDREC,U,3)=$PIECE($GET(^DPT(+ABMDIEN,.11)),U,4)
+6 ;pt state
SET $PIECE(ABMDREC,U,4)=$SELECT($PIECE($GET(^DPT(+ABMDIEN,.11)),U,5):$PIECE($GET(^DIC(5,$PIECE(^DPT(+ABMDIEN,.11),U,5),0)),U),1:"")
+7 ;pt zip
SET $PIECE(ABMDREC,U,5)=$PIECE($GET(^DPT(+ABMDIEN,.11)),U,6)
End DoDot:1
QUIT ABMDREC
+8 ;
+9 IF $PIECE(ABMDIEN,";",2)["AUTTLOC"
Begin DoDot:1
+10 ;loc name
SET ABMDREC=$PIECE($GET(^AUTTLOC(+ABMDIEN,0)),U)
+11 IF $GET(ABMDREC)'=""
SET ABMDREC=$PIECE($GET(^DIC(4,ABMDREC,0)),U)
+12 ;loc street
SET $PIECE(ABMDREC,U,2)=$PIECE($GET(^AUTTLOC(+ABMDIEN,0)),U,12)
+13 ;loc city
SET $PIECE(ABMDREC,U,3)=$PIECE($GET(^AUTTLOC(+ABMDIEN,0)),U,13)
+14 ;loc state
SET $PIECE(ABMDREC,U,4)=$SELECT($PIECE($GET(^AUTTLOC(+ABMDIEN,0)),U,14):$PIECE($GET(^DIC(5,$PIECE(^AUTTLOC(+ABMDIEN,0),U,14),0)),U),1:"")
+15 ;loc zip
SET $PIECE(ABMDREC,U,5)=$PIECE($GET(^AUTTLOC(+ABMDIEN,0)),U,15)
End DoDot:1
QUIT ABMDREC
+16 ;
+17 IF $PIECE(ABMDIEN,";",2)["AUTTVNDR"
Begin DoDot:1
+18 ;vndr name
SET ABMDREC=$PIECE($GET(^AUTTVNDR(+ABMDIEN,0)),U)
+19 ;vndr street
SET $PIECE(ABMDREC,U,2)=$PIECE($GET(^AUTTVNDR(+ABMDIEN,13)),U)
+20 ;vndr city
SET $PIECE(ABMDREC,U,3)=$PIECE($GET(^AUTTVNDR(+ABMDIEN,13)),U,2)
+21 ;vndr state
SET $PIECE(ABMDREC,U,4)=$SELECT($PIECE($GET(^AUTTVNDR(+ABMDIEN,13)),U,3):$PIECE($GET(^DIC(5,$PIECE(^AUTTVNDR(+ABMDIEN,13),U,3),0)),U),1:"")
+22 ;vndr zip
SET $PIECE(ABMDREC,U,5)=$PIECE($GET(^AUTTVNDR(+ABMDIEN,13)),U,4)
End DoDot:1
QUIT ABMDREC
+23 QUIT ABMDREC
VALSTUFF ;
+1 KILL DA,DA(1),DIC,DR,DIR
+2 SET DA(1)=ABMP("CDFN")
+3 SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
+4 SET DIC(0)="LM"
+5 SET DIC("P")=$PIECE(^DD(9002274.3,55,0),U,2)
+6 SET X="A0"
+7 KILL DD,DO
+8 DO ^DIC
+9 IF +Y<0
QUIT
+10 KILL DA,DA(1),DR,DIC,DIR
+11 SET DA=+Y
+12 SET DA(1)=ABMP("CDFN")
+13 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
+14 SET DR=".02////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,6)
+15 DO ^DIE
+16 QUIT
+17 ; Entry of Claim Identifiers
2 ;;.1214 Point of Pickup Modifier
4 ;;.1216 Destination Modifier
7 ;;.1215 Was ambulance transport considered MEDICALLY NECESSARY?
8 ;;.1211
+1 ;; abm*2.6*6 5010 moved 9 to 10; 10 to 11; added new 9 for pt count
9 ;;1218
10 ;;.1212
11 ;;.1213
+1 ;
+2 ;transported to/for descriptions
A ;;NEAREST FAC.-CARE OF SYMPTOMS/COMPLAINTS/BOTH
B ;;BENEFIT OF PREFERRED PHYSICIAN
C ;;NEARNESS OF FAMILY MEMBERS
D ;;A SPECIALIST/AVAILABILITY OF SPECIALIZED EQUIP
E ;;TRANSFERRED TO REHAB FACILITY
