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

ABMER80.m

Go to the documentation of this file. 
  1. ABMER80 ; IHS/ASDST/DMJ - UB92 EMC RECORD 80 (PHYSICIAN DATA) ;    
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
  1.  ;Original;DMJ;08/18/95 10:09 AM
  1.  ;  
  1.  ; IHS/ASDS/SDH - 04/26/01 - V2.4 Patch 9 - NOIS NCA-1100-180025
  1.  ;     Insert leading 00 before providers for AHCCCS
  1.  ; IHS/ASDS/DMJ - 12/04/01 - V2.4 Patch 10 - NOIS HQW-1201-100015
  1.  ;     Sequence 80 record w/o skipping numbers
  1.  ;
  1.  ; IHS/SD/LSL - 09/05/02 0 v2.5 Patch 2
  1.  ;     Added Kidscare check when getting provider numbers.
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 check from 'equals' to 'contains'
  1.  ; *********************************************************************
  1.  ;
  1. START ;START HERE
  1.  K ABMR(80),ABMREC(80)
  1.  S ABME("RTYPE")=80
  1.  D SET^ABMERUTL
  1.  F ABME("S#")=1:1:3 D
  1.  .Q:'$D(ABMP("INS",ABME("S#")))
  1.  .;I $$RCID^ABMERUTL(ABMP("INS"))=61044,ABME("S#")>1 Q  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .I $$RCID^ABMERUTL(ABMP("INS"))["61044",ABME("S#")>1 Q  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .S ABME("NTYPE")=$S($P(ABMP("INS",ABME("S#")),"^",2)="D":"D",$P(ABMP("INS",ABME("S#")),"^",2)="R":"R",1:"P")
  1.  .I $$RCID^ABMERUTL(ABMP("INS"))=99999,ABME("NTYPE")'="D" Q
  1.  .S ABME("NTYPE",ABME("NTYPE"))=""
  1.  .D LOOP
  1.  .D S90^ABMERUTL
  1.  K ABM,ABME
  1.  Q
  1. LOOP ;LOOP HERE
  1.  F I=10:10:130 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),80,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(80,ABME("S#"))=$G(ABMREC(80,ABME("S#")))_ABMR(80,I)
  1.  Q
  1. 10 ;Record type
  1.  S ABMR(80,10)=80
  1.  Q
  1. 20 ;Sequence 
  1.  S ABMR(80,20)=ABME("S#")
  1.  S:$$RCID^ABMERUTL(ABMP("INS"))=99999 ABMR(80,20)=1
  1.  S ABMR(80,20)=$$FMT^ABMERUTL(ABMR(80,20),"2NR")
  1.  Q
  1. 30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
  1.  S ABMR(80,30)=$$EX^ABMER20(30,ABMP("BDFN"))
  1.  S ABMR(80,30)=$$FMT^ABMERUTL(ABMR(80,30),20)
  1.  Q
  1. 40 ;Physician Number Qualifying Codes (SOURCE: FILE=9002274.4041 FIELD=)
  1.  S ABMR(80,40)=$S(ABME("NTYPE")="D":"",ABME("NTYPE")="R":"UP",1:"SL")
  1.  S ABMR(80,40)=$$FMT^ABMERUTL(ABMR(80,40),2)
  1.  Q
  1. 50 ;Attending Physician Number (SOURCE: FILE=9002274.4041, FIELD=) 
  1.  D GET41 S ABMR(80,50)=$P(ABM(41,1),U)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,50)="OO"_ABMR(80,50)
  1.  I $$ENVOY^ABMEF16 D
  1.  .S ABMR(80,50)=$$REPLNOT^ABMER10(ABMR(80,50),", ")
  1.  S ABMR(80,50)=$$FMT^ABMERUTL(ABMR(80,50),16)
  1.  Q
  1. 60 ;Operating or Other Physician Number (SOURCE: FILE=9002274.4041, FIELD=)
  1.  D GET41 S ABMR(80,60)=$P(ABM(41,2),U)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,60)="00"_ABMR(80,60)
  1.  S ABMR(80,60)=$$FMT^ABMERUTL(ABMR(80,60),16)
  1.  Q
  1. 70 ;Other Physician Number 1 (SOURCE: FILE=9002274.4041, FIELD=)
  1.  D GET41 S ABMR(80,70)=$P(ABM(41,3),U)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,70)="00"_ABMR(80,70)
  1.  S ABMR(80,70)=$$FMT^ABMERUTL(ABMR(80,70),16)
  1.  Q
  1. 80 ;Other Physician Number 2 (SOURCE: FILE=9002274.4041, FIELD=)
  1.  D GET41 S ABMR(80,80)=$P(ABM(41,4),U)
  1.  I $$RCID^ABMERUTL(ABMP("INS"))=99999 S ABMR(80,80)="00"_ABMR(80,80)
  1.  S ABMR(80,80)=$$FMT^ABMERUTL(ABMR(80,80),16)
  1.  Q
  1. 90 ;Attending Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
  1.  D GET41 S ABMR(80,90)=$P(ABM(41,1),"^",2)
  1.  S ABMR(80,90)=$$FMT^ABMERUTL(ABMR(80,90),25)
  1.  Q
  1. 100 ;Operating or Other Physician Name (SOURCE: FILE=9002274.4041, FIELD=)
  1.  D GET41 S ABMR(80,100)=$P(ABM(41,2),"^",2)
  1.  S ABMR(80,100)=$$FMT^ABMERUTL(ABMR(80,100),25)
  1.  Q
  1. 110 ;Other Physician Name 1 (SOURCE: FILE=9002274.4017, FIELD=.01)
  1.  D GET41 S ABMR(80,110)=$P(ABM(41,3),"^",2)
  1.  S ABMR(80,110)=$$FMT^ABMERUTL(ABMR(80,110),25)
  1.  Q
  1. 120 ;Other Physician Name 2 (SOURCE: FILE=9002274.4017, FIELD=.01)     
  1.  D GET41 S ABMR(80,120)=$P(ABM(41,4),"^",2)
  1.  S ABMR(80,120)=$$FMT^ABMERUTL(ABMR(80,120),25)
  1.  Q
  1. 130 ;Filler
  1.  S ABMR(80,130)=""
  1.  S ABMR(80,130)=$$FMT^ABMERUTL(ABMR(80,130),2)
  1.  Q
  1. GET41 ;EP - get provider information
  1.  Q:$D(ABM(41))
  1.  S CNT=1
  1.  N I S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0)),DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U) I 'DA S ABM(41,1)=""
  1.  D:DA GP
  1.  S CNT=2
  1.  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","O",0)),DA=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,+I,0)),U)
  1.  I DA D GP
  1.  S I=0 F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","R",I)) Q:'I!(CNT>3)  D
  1.  .S DA=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,I,0),U)
  1.  .S CNT=CNT+1 D GP
  1.  F I=1:1:4 I '$D(ABM(41,I)) S ABM(41,I)=""
  1.  Q
  1. GP ;GIVEN DA GET PROVIDER NAME AND NUMBER
  1.  D DIQ1
  1.  S ABM("LNAME")=$P(ABM(200,DA,.01,"E")," ",1)
  1.  S ABM("FNAME")=$P(ABM("LNAME"),",",2),ABM("LNAME")=$P(ABM("LNAME"),",",1)
  1.  S ABM("LNAME")=ABM("LNAME")_ABMP("SPACES"),ABM("LNAME")=$E(ABM("LNAME"),1,16)
  1.  S ABM("FNAME")=ABM("FNAME")_ABMP("SPACES"),ABM("FNAME")=$E(ABM("FNAME"),1,8)
  1.  S ABM("MI")=$P(ABM(200,DA,.01,"E"),",",2),ABM("MI")=$P(ABM("MI")," ",2),ABM("MI")=$E(ABM("MI")) I ABM("MI")="" S ABM("MI")=" "
  1.  S ABM("P#")=$P($G(^VA(200,DA,9999999.18,ABMP("INS"),0)),"^",2)
  1.  I ABM("P#")="" D
  1.  .S:(ABME("NTYPE")="D"!(ABME("NTYPE")="K")) ABM("P#")=ABM(200,DA,9999999.07,"E")
  1.  .I ABME("NTYPE")="R" D
  1.  ..S ABM("P#")=ABM(200,DA,9999999.08,"E")
  1.  ..S:ABM("P#")="" ABM("P#")="PHS000"
  1.  .I ABME("NTYPE")="P" D
  1.  ..S ABM("LSTATE")=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)
  1.  ..S:ABM("LSTATE")="" ABM("LSTATE")=$P(^AUTTLOC(+ABMP("LDFN"),0),"^",14)
  1.  ..S ABM("P#")=$$SLN^ABMERUTL(DA,ABM("LSTATE"))
  1.  S ABM(41,CNT)=ABM("P#")_"^"_ABM("LNAME")_ABM("FNAME")_ABM("MI")
  1.  Q
  1. DIQ1 ;GET PROVIDER INFO
  1.  N I S DR=".01;9999999.07;9999999.08",DIQ="ABM",DIQ(0)="E",DIC="^VA(200," D EN^DIQ1 K DIQ
  1.  S:ABM(200,DA,9999999.08,"E")="" ABM(200,DA,9999999.08,"E")="PHS000"
  1.  Q
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
  1.  ;X=data element, Y=bill internal entry number
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(80,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(80,ABMX),ABME,ABMX,ABMY,ABMZ,ABM
  1.  Q Y