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

ABME570.m

Go to the documentation of this file. 
  1. ABME570 ; IHS/ASDST/DMJ - UB92 V5 EMC RECORD 70-1 (Medical) ; 
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
  1.  ;Original;DMJ;08/18/95 10:07 AM
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
  1.  ;
  1. START ;START HERE
  1.  K ABMR(70),ABMREC(70)
  1.  S ABME("RTYPE")=70
  1.  D SET^ABMERUTL,LOOP
  1.  D S90^ABMERUTL
  1.  K ABM,ABME
  1.  Q
  1.  ;
  1. LOOP ;LOOP HERE
  1.  D ^ABME570A
  1.  F I=130:10:280 D
  1.  .D @I
  1.  .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),70,I)) D @(^(I))
  1.  .I '$G(ABMP("NOFMT")) S ABMREC(70)=$G(ABMREC(70))_ABMR(70,I)
  1.  Q
  1.  ;
  1. 130 ;Principle Surgical Procedure Code, 79-85 (SOURCE: FILE=9002274.4 FIELD=)
  1.  ; form locator #80
  1.  D SCODE
  1.  S ABMR(70,130)=$P(ABM("SC",1),U)
  1.  S ABMR(70,130)=$$FMT^ABMERUTL(ABMR(70,130),7)
  1.  Q
  1.  ;
  1. 140 ;Principle Surgical Procedure Date, 86-93 (SOURCE: FILE=9002274.4 FIELD=)
  1.  ; form locator #80
  1.  D SCODE
  1.  S Y=$P(ABM("SC",1),"^",2)
  1.  S ABMR(70,140)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,140)=$$FMT^ABMERUTL(ABMR(70,140),8)
  1.  Q
  1.  ;
  1. 150 ;Other Surgical Procedure Code #1, 94-100 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S ABMR(70,150)=$P(ABM("SC",2),U)
  1.  S ABMR(70,150)=$$FMT^ABMERUTL(ABMR(70,150),7)
  1.  Q
  1.  ;
  1. 160 ;Other Surgical Procedure Date #1, 101-108 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S Y=$P(ABM("SC",2),"^",2)
  1.  S ABMR(70,160)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,160)=$$FMT^ABMERUTL(ABMR(70,160),8)
  1.  Q
  1.  ;
  1. 170 ;Other Surgical Procedure Code #2, 109-115 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S ABMR(70,170)=$P(ABM("SC",3),U)
  1.  S ABMR(70,170)=$$FMT^ABMERUTL(ABMR(70,170),7)
  1.  Q
  1. 180 ;Other Surgical Procedure Date #2, 116-123 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S Y=$P(ABM("SC",3),"^",2)
  1.  S ABMR(70,180)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,180)=$$FMT^ABMERUTL(ABMR(70,180),8)
  1.  Q
  1.  ;
  1. 190 ;Other Surgical Procedure Code #3, 124-130 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S ABMR(70,190)=$P(ABM("SC",4),U)
  1.  S ABMR(70,190)=$$FMT^ABMERUTL(ABMR(70,190),7)
  1.  Q
  1.  ;
  1. 200 ;Other Surgical Procedure Date #3, 131-138 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S Y=$P(ABM("SC",4),"^",2)
  1.  S ABMR(70,200)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,200)=$$FMT^ABMERUTL(ABMR(70,200),8)
  1.  Q
  1.  ;
  1. 210 ;Other Surgical Procedure Code #4, 139-145 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S ABMR(70,210)=$P(ABM("SC",5),U)
  1.  S ABMR(70,210)=$$FMT^ABMERUTL(ABMR(70,210),7)
  1.  Q
  1.  ;
  1. 220 ;Other Surgical Procedure Date #4, 146-153 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S Y=$P(ABM("SC",5),"^",2)
  1.  S ABMR(70,220)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,220)=$$FMT^ABMERUTL(ABMR(70,220),8)
  1.  Q
  1.  ;
  1. 230 ;Other Surgical Procedure Code #5, 154-160 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S ABMR(70,230)=$P(ABM("SC",6),U)
  1.  S ABMR(70,230)=$$FMT^ABMERUTL(ABMR(70,230),7)
  1.  Q
  1.  ;
  1. 240 ;Other Surgical Procedure Date #5, 161-168 (SOURCE: FILE=9002274.4)
  1.  ; form locator #81
  1.  D SCODE
  1.  S Y=$P(ABM("SC",6),"^",2)
  1.  S ABMR(70,240)=$$Y2KD2^ABMDUTL(Y)
  1.  S ABMR(70,240)=$$FMT^ABMERUTL(ABMR(70,240),8)
  1.  Q
  1.  ;
  1. 250 ;Admitting Diagnosis, 169-174 (SOURCE: FILE=9002274.4, FIELD=.59)
  1.  ; form locator #76
  1.  D:'$D(ABM(9002274.4,ABMP("BDFN"),.59)) DIQ1
  1.  S ABMR(70,250)=ABM(9002274.4,ABMP("BDFN"),.59,"E")
  1.  S ABMR(70,250)=$TR(ABMR(70,250),".")
  1.  S ABMR(70,250)=$$FMT^ABMERUTL(ABMR(70,250),6)
  1.  Q
  1.  ;
  1. 260 ;External Cause of Injury, 175-180 (SOURCE: FILE=9002274.4, FIELD=)
  1.  ; form locator #77
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,I)) Q:'I  D
  1.  .Q:$D(ABMR(70,260))
  1.  .;I $E($P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2))="E" S ABMR(70,260)=$P($$DX^ABMCVAPI(I,ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 updated API call
  1.  .I $E($P($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2))="E" S ABMR(70,260)=$P($$DX^ABMCVAPI(+I,ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 updated API call
  1.  S ABMR(70,260)=$TR($G(ABMR(70,260)),".")
  1.  S ABMR(70,260)=$$FMT^ABMERUTL(ABMR(70,260),6)
  1.  Q
  1.  ;
  1. 270 ;Procedure Coding Method Used, 181-181 (SOURCE: FILE=9999999.18, FIELD=)
  1.  ; form locator #79
  1.  S ABMR(70,270)=$S($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":9,1:4)
  1.  S ABMR(70,270)=$$FMT^ABMERUTL(ABMR(70,270),"1N")
  1.  Q
  1.  ;
  1. 280 ;Filler (National Use), 182-192
  1.  S ABMR(70,280)=""
  1.  S ABMR(70,280)=$$FMT^ABMERUTL(ABMR(70,280),11)
  1.  Q
  1.  ;
  1. SCODE ;SURGICAL PROCEDURE CODES
  1.  Q:$D(ABM("SC"))   ; Quit if already done
  1.  ; if procedure coding method used is ICD use node 19,
  1.  ;   else use node 21 (Med/Surg)
  1.  S ABM("SUB")=$S($P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,+ABMP("VTYP"),0)),"^",2)="I":19,1:21)
  1.  N I
  1.  S I=0,CNT=0
  1.  ; loop INS priority order
  1.  F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I)) Q:'I  D
  1.  .N J
  1.  .S J=0
  1.  .; Loop IEN to multiple
  1.  .F  S J=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),"C",I,J)) Q:'J  D
  1.  ..S CNT=CNT+1  ; increment counter
  1.  ..S ABM("ZERO")=^ABMDBILL(DUZ(2),ABMP("BDFN"),ABM("SUB"),J,0)
  1.  ..I ABM("SUB")=19 D   ; ICD procedure code ^ date of service
  1.  ...S ABM("SC",CNT)=$P($$ICDOP^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$P(ABM("ZERO"),U,3)  ;CSV-c
  1.  ...Q:$P($G(^ABMDEXP(ABMP("EXP"),1)),"^",5)'="E"
  1.  ...S ABM("SC",CNT)=$TR(ABM("SC",CNT),".")
  1.  ..; CPT code ^ date/time
  1.  ..I ABM("SUB")=21 S ABM("SC",CNT)=$P($$CPT^ABMCVAPI(+ABM("ZERO"),ABMP("VDT")),U,2)_"^"_$P(ABM("ZERO"),U,5)  ;CSV-c
  1.  F I=1:1:6 S:'$D(ABM("SC",I)) ABM("SC",I)=""
  1.  Q
  1.  ;
  1. DIQ1 ;GET INFO FROM FILE 9002274.4
  1.  N I
  1.  S DA=ABMP("BDFN")
  1.  S DR=".59;.857"
  1.  S DIQ="ABM"
  1.  S DIQ(0)="E"
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  D EN^DIQ1
  1.  K DIQ
  1.  Q
  1.  ;
  1. EX(ABMX,ABMY) ;EXTRINSIC FUNCTION HERE
  1.  ;
  1.  ;  INPUT: ABMX = data element
  1.  ;            Y = bill internal entry number
  1.  ;
  1.  ; OUTPUT:    Y = bill internal entry number
  1.  ;         
  1.  I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
  1.  D @ABMX
  1.  S Y=ABMR(70,ABMX)
  1.  I $D(ABMP("FMT")) S ABMP("FMT")=1
  1.  K ABMR(70,ABMX),ABMX,ABMY
  1.  Q Y