Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE31

ABMDE31.m

Go to the documentation of this file. 
  1. ABMDE31 ;IHS/SD/SDR - AMBULANCE - PAGE 3A ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**6**;NOV 12, 2009
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - task 6 - New routine for page 3A
  1.  ; IHS/SD/SDR - abm*2.6*6 - 5010 - added patient count
  1.  ;
  1.  ;
  1. OPT ;EP
  1.  G XIT:$D(ABMP("WORKSHEET"))
  1.  K ABM,ABME,ABMZ,DUOUT,ABMP("QU")
  1.  S ABMP("OPT")="ENVJBQ"
  1.  D DISP
  1.  G XIT:$D(DTOUT)!$D(DIROUT)
  1.  D ^ABMDE31X
  1.  I +$O(ABME(0)) D
  1.  . S ABME("CONT")=""
  1.  . D ^ABMDERR
  1.  . K ABME("CONT")
  1.  G XIT:$D(DTOUT)!$D(DIROUT)
  1.  W !
  1.  D SEL^ABMDEOPT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!("EV"'[$E(Y))
  1.  S ABM("DO")=$S($E(Y)="E":"E1",1:"V1")
  1.  W !
  1.  D @ABM("DO")
  1.  G XIT:$D(DTOUT)!$D(DIROUT)
  1.  G OPT
  1. V1 ;View data
  1.  S ABMZ("TITL")="AMBULANCE QUESTIONS - VIEW OPTION"
  1.  D SUM^ABMDE1
  1.  D ^ABMDERR
  1.  Q
  1. E1 ;Edit data
  1.  ;S ABMP("FLDS")=10  ;abm*2.6*6 5010
  1.  S ABMP("FLDS")=11  ;abm*2.6*6 5010
  1.  D FLDS^ABMDEOPT
  1.  W !
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  S DR=""
  1.  F ABM("I")=1:1 S ABM=$P(ABMP("FLDS"),",",ABM("I")) Q:ABM=""  D
  1.  .Q:$P(ABMP("FLDS"),",",ABM("I"))=3
  1.  .S:ABM("I")>1 DR=DR_";"
  1.  .S DR=DR_$P($T(@ABM),";;",2)
  1.  S DIE="^ABMDCLM(DUZ(2),"
  1.  S DA=ABMP("CDFN")
  1.  D ^DIE
  1.  ; other fields for Point of Pickup (1)
  1.  I ABMP("FLDS")=1!(ABMP("FLDS")["1,") D
  1.  .K DIE,DA,DR,DIC,X,Y
  1.  .S DIE="^ABMDCLM(DUZ(2),"
  1.  .S DA=ABMP("CDFN")
  1.  .S DR=".122R//PATIENT'S HOME"
  1.  .D ^DIE
  1.  .I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,2)'="PATIENT'S HOME" S DR=".123:.126;.1214"
  1.  .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"
  1.  .D ^DIE
  1.  .D VALSTUFF  ;stuff zip code with A0 as value code on 9D
  1.  ;destination (3)
  1.  I ABMP("FLDS")[3 D
  1.  .K DIR,DIC,DIE,DR,DA,X
  1.  .S DA=ABMP("CDFN")
  1.  .S DIE="^ABMDCLM("_DUZ(2)_","
  1.  .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"")"
  1.  .S ABMDVAR=$P($G(^DIC(4,DUZ(2),0)),U)
  1.  .S DR=".127//^S X=ABMDVAR;.1216Destination Modifier"
  1.  .D ^DIE
  1.  ;
  1.  I ABMP("FLDS")[5 D
  1.  .K DIR,DIC,DIE,DR,DA,DIR
  1.  .S DA=ABMP("CDFN")
  1.  .S DR=.128
  1.  .S DIE="^ABMDCLM("_DUZ(2)_","
  1.  .D ^DIE
  1.  .K DIR,DIC,DIE,DR,DA,DIR
  1.  I ABMP("FLDS")[6 D
  1.  .K DIR,DIC,DIE,DR,DA,DIR
  1.  .S DA=ABMP("CDFN")
  1.  .S DR=.129
  1.  .S DIE="^ABMDCLM("_DUZ(2)_","
  1.  .D ^DIE
  1.  .K DIR,DIC,DIE,DR,DA,DIR
  1.  ;other fields for medical necessity ind (5)
  1.  I ABMP("FLDS")[7 D
  1.  .S ABMANS=X
  1.  .I ABMANS="Y" D
  1.  ..F  D  Q:(+$G(Y)<1)!$D(DUOUT)!$D(DTOUT)
  1.  ...K DIC
  1.  ...S DA(1)=ABMP("CDFN")
  1.  ...S ABMENTRY=+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,0)),U,4)
  1.  ...S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
  1.  ...S DIC(0)=$S(ABMENTRY=5:"AEMQ",1:"AELMQ")
  1.  ...I ABMENTRY'=0 S DIC("A")=$S(ABMENTRY=1:"2nd ",ABMENTRY=2:"3rd ",ABMENTRY=3:"4th ",ABMENTRY=4:"5th ",1:"")
  1.  ...S DIC("P")=$P(^DD(9002274.3,14,0),U,2)
  1.  ...S DIC("A")=$G(DIC("A"))_"Condition indicator (reason): "
  1.  ...K DD,DO
  1.  ...D ^DIC
  1.  ...I (+$G(Y)>0),$P(Y,U,3)="" D
  1.  ....S DIE=DIC
  1.  ....S DA=+Y
  1.  ....S DR=".01Condition indicator//"
  1.  ....D ^DIE
  1.  .I ABMANS="N" D  ;make sure no condition indicators if no
  1.  ..S DA(1)=ABMP("CDFN")
  1.  ..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",14,"
  1.  ..S ABMIEN=0
  1.  ..F  S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMIEN)) Q:ABMIEN=""  D
  1.  ...S DA=ABMIEN
  1.  ...D ^DIK
  1.  ;
  1.  K DR
  1.  Q
  1. DISP ;
  1.  S ABMZ("TITL")="AMBULANCE QUESTIONS"
  1.  S ABMZ("PG")="3A"
  1.  I $D(ABMP("DDL")),$Y>(IOSL-6) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  I 1
  1.  E  D SUM^ABMDE1
  1.  ;
  1.  S ABMAREC=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12))
  1.  W !?3,"[01] Point of Pickup........: ",$P(ABMAREC,U,2)  ;origin
  1.  W !?33,$P(ABMAREC,U,3)  ;origin address
  1.  W !?33,$S($P(ABMAREC,U,4)'="":$P(ABMAREC,U,4),1:"")  ;origin city
  1.  W $S($P(ABMAREC,U,5)'="":", "_$P($G(^DIC(5,$P(ABMAREC,U,5),0)),U),1:"")  ;origin state
  1.  W $S($P(ABMAREC,U,6)'="":"  "_$P(ABMAREC,U,6),1:"")  ;origin zip
  1.  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
  1.  ;
  1.  S ABMDIEN=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,7)
  1.  S ABMDREC=$$GETDEST(ABMDIEN)  ;variable pointer; get data
  1.  W !?3,"[03] Destination............: ",$P(ABMDREC,U)  ;destination
  1.  W !?33,$P(ABMDREC,U,2)  ;destination address
  1.  W !?33,$P(ABMDREC,U,3)  ;destination city
  1.  W $S($P(ABMDREC,U,4)'="":", "_$P(ABMDREC,U,4),1:"")
  1.  W $S($P(ABMDREC,U,5)'="":"  "_$P(ABMDREC,U,5),1:"")  ;destination state/zip
  1.  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
  1.  ;
  1.  W !
  1.  W !?3,"[05] Mileage (Covered)......: ",$P(ABMAREC,U,8)
  1.  W !?3,"[06] Mileage (Non-Covered)..: ",$P(ABMAREC,U,9)
  1.  ;
  1.  W !?3,"[07] Medical Necessity Ind..: ",$P(ABMAREC,U,15)
  1.  S ABMCONDI=0
  1.  F  S ABMCONDI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI))  Q:+ABMCONDI=0  D
  1.  .S ABMCOND=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),14,ABMCONDI,0)),U)
  1.  .W !?9,"Condition Indicator...: ",$P($G(^ABMCNDIN(ABMCOND,0)),U)_" "_$E($P($G(^ABMCNDIN(ABMCOND,0)),U,2),1,43)
  1.  ;
  1.  W !?3,"[08] Patient Weight (lbs)...: ",$P(ABMAREC,U,11)
  1.  W !?3,"[09] Patient Count..........: ",$P(ABMAREC,U,18)  ;abm*2.6*6 5010
  1.  W !
  1.  W !,"Transfers Only:"
  1.  S ABMTRNST=$P(ABMAREC,U,12)
  1.  S:ABMTRNST'="" ABMTRNST=$S(ABMTRNST="I":"INITIAL TRIP",ABMTRNST="R":"RETURN TRIP",ABMTRNST="T":"TRANSFER TRIP",1:"ROUND TRIP")
  1.  ;start old code abm*2.6*6 5010
  1.  ;W !?3,"[09] Type of Transport......: ",ABMTRNST
  1.  ;W !?3,"[10] Transported To/For.....: "
  1.  ;I $P(ABMAREC,U,13)'="" W $P($T(@($P(ABMAREC,U,13))),";;",2)
  1.  ;end old code start new code 5010
  1.  W !?3,"[10] Type of Transport......: ",ABMTRNST
  1.  W !?3,"[11] Transported To/For.....: "
  1.  I $P(ABMAREC,U,13)'="" W $P($T(@($P(ABMAREC,U,13))),";;",2)
  1.  ;end new code 5010
  1.  W !
  1.  K ABMAREC
  1.  Q
  1. XIT ;
  1.  S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
  1.  K ABM,ABMV,ABME
  1.  Q
  1. GETDEST(ABMDIEN) ;EP - figure out data for destination - variable pointer
  1.  I $G(ABMDIEN)="" S ABMDREC="" Q ""
  1.  I $P(ABMDIEN,";",2)["AUPNPAT" D  Q ABMDREC
  1.  .S ABMDREC="PATIENT'S HOME"
  1.  .S $P(ABMDREC,U,2)=$P($G(^DPT(+ABMDIEN,.11)),U)  ;pt street
  1.  .S $P(ABMDREC,U,3)=$P($G(^DPT(+ABMDIEN,.11)),U,4)  ;pt city
  1.  .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
  1.  .S $P(ABMDREC,U,5)=$P($G(^DPT(+ABMDIEN,.11)),U,6)  ;pt zip
  1.  ;
  1.  I $P(ABMDIEN,";",2)["AUTTLOC" D  Q ABMDREC
  1.  .S ABMDREC=$P($G(^AUTTLOC(+ABMDIEN,0)),U)  ;loc name
  1.  .S:$G(ABMDREC)'="" ABMDREC=$P($G(^DIC(4,ABMDREC,0)),U)
  1.  .S $P(ABMDREC,U,2)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,12)  ;loc street
  1.  .S $P(ABMDREC,U,3)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,13)  ;loc city
  1.  .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
  1.  .S $P(ABMDREC,U,5)=$P($G(^AUTTLOC(+ABMDIEN,0)),U,15)  ;loc zip
  1.  ;
  1.  I $P(ABMDIEN,";",2)["AUTTVNDR" D  Q ABMDREC
  1.  .S ABMDREC=$P($G(^AUTTVNDR(+ABMDIEN,0)),U)  ;vndr name
  1.  .S $P(ABMDREC,U,2)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U)  ;vndr street
  1.  .S $P(ABMDREC,U,3)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U,2)  ;vndr city
  1.  .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
  1.  .S $P(ABMDREC,U,5)=$P($G(^AUTTVNDR(+ABMDIEN,13)),U,4)  ;vndr zip
  1.  Q ABMDREC
  1. VALSTUFF ;
  1.  K DA,DA(1),DIC,DR,DIR
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
  1.  S DIC(0)="LM"
  1.  S DIC("P")=$P(^DD(9002274.3,55,0),U,2)
  1.  S X="A0"
  1.  K DD,DO
  1.  D ^DIC
  1.  Q:+Y<0
  1.  K DA,DA(1),DR,DIC,DIR
  1.  S DA=+Y
  1.  S DA(1)=ABMP("CDFN")
  1.  S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",55,"
  1.  S DR=".02////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,6)
  1.  D ^DIE
  1.  Q
  1.  ; Entry of Claim Identifiers
  1. 2 ;;.1214 Point of Pickup Modifier
  1. 4 ;;.1216 Destination Modifier
  1. 7 ;;.1215 Was ambulance transport considered MEDICALLY NECESSARY?
  1. 8 ;;.1211
  1.  ;; abm*2.6*6 5010 moved 9 to 10; 10 to 11; added new 9 for pt count
  1. 9 ;;1218
  1. 10 ;;.1212
  1. 11 ;;.1213
  1.  ;
  1.  ;transported to/for descriptions
  1. A ;;NEAREST FAC.-CARE OF SYMPTOMS/COMPLAINTS/BOTH
  1. B ;;BENEFIT OF PREFERRED PHYSICIAN
  1. C ;;NEARNESS OF FAMILY MEMBERS
  1. D ;;A SPECIALIST/AVAILABILITY OF SPECIALIZED EQUIP
  1. E ;;TRANSFERRED TO REHAB FACILITY