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

ABMDF1E.m

Go to the documentation of this file. 
  1. ABMDF1E ; IHS/SD/SDR - Set UB82 Print Array - Part 5 ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**10,14**;NOV 12, 2009;Build 238
  1.  ;Original;TMD;
  1.  ;
  1.  ;IHS/DSD/DMJ - 5/14/1999 - NOIS HQW-0599-100027 Patch 2
  1.  ;          Y2K IV&V issues, all $$HDT^ABMDUTL changed to $$HDTO^ABMDUTL
  1.  ;                    in lines: 55+5,CPT55+4,MED+4
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric
  1.  ;
  1. 53 ; Diagnosis Info
  1.  S (ABMU("TXT"),ABMF(53),ABM)="" F ABM("I")=1:1:5 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM)) Q:'ABM  D
  1.  .S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABM,""))
  1.  .;S ABMF(53)=ABMF(53)_U_$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 update API call
  1.  .S ABMF(53)=ABMF(53)_U_$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)  ;CSV-c  ;abm*2.6*14 update API call
  1.  .S ABM("PRVN")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABM("X"),0),U,3)
  1.  .S ABM(9)=$P($G(^AUTNPOV(+ABM("PRVN"),0)),U)
  1.  .;I ABM(9)=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,2) S ABM(9)=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,4)  ;CSV-c  ;abm*2.6*14 update API call
  1.  .I ABM(9)=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2) S ABM(9)=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,4)  ;CSV-c  ;abm*2.6*14 update API call
  1.  .S ABMU("TXT")=ABMU("TXT")_", "_$S(ABM(9)["*ICD*":$P(ABM(9),"  "),1:ABM(9))
  1.  S ABMU("TXT")=$P(ABMU("TXT"),", ",2,99)
  1.  I $L(ABMU("TXT"))>45 S ABMU("LNG")=26,ABMU("TAB")=19,ABMU=2 D LNG^ABMDWRAP S $P(ABMF(52),U)=ABMU(1),$P(ABMF(53),U)=ABMU(2) K ABMU I 1
  1.  E  S $P(ABMF(53),U)=ABMU("TXT")
  1.  G 55
  1.  ;
  1. 55 ; ICD Procedure Info
  1.  S ABMU("TXT")=""
  1.  I ABMP("PX")="C" G CPT55
  1.  S ABMF(55)="",ABM="" F  S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",ABM)) Q:ABM=""  S ABM("X0")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,"C",ABM,"")) D
  1.  .S ABMF(55)=ABMF(55)_"^"_$P($$ICDOP^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)  ;CSV-c
  1.  .S ABMF(55)=ABMF(55)_"^"_$$HDTO^ABMDUTL($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,ABM("X0"),0),U,3))
  1.  .S ABM(9)=$P(^AUTNPOV($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),19,ABM("X0"),0),U,4),0),U)
  1.  .S ABMU("TXT")=ABMU("TXT")_", "_$S(ABM(9)["*ICD*":$P(ABM(9),"  "),1:ABM(9))
  1.  S:ABMF(55)]"" ABMF(55)="9^"_ABMF(55)
  1.  D:ABMU("TXT")]"" PXTXT
  1.  G 57
  1.  ;
  1. CPT55 ; CPT Procedure Info
  1.  S ABMF(55)="",ABM="" F  S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),21,"C",ABM)) Q:ABM=""  S ABM("X1")=$O(^(ABM,"")) D
  1.  .S ABM("X0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),21,ABM("X1"),0)
  1.  .S ABMF(55)=ABMF(55)_"^"_$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)  ;CSV-c
  1.  .S ABMF(55)=ABMF(55)_"^"_$$HDTO^ABMDUTL($P(ABM("X0"),U,5))
  1.  .S ABMU("TXT")=ABMU("TXT")_", "_$P($G(^AUTNPOV($P(ABM("X0"),U,6),0)),U)
  1.  I $L(ABMF(55),"^")<6 D MED
  1.  S:ABMF(55)]"" ABMF(55)="4^"_ABMF(55)
  1.  D:ABMU("TXT")]"" PXTXT
  1.  G 57
  1.  ;
  1. MED S ABM=0 F  S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),27,ABM)) Q:'ABM  D
  1.  .I $P($$CPT^ABMCVAPI(ABM,ABMP("VDT")),U,4)>22,$P($$CPT^ABMCVAPI(ABM,ABMP("VDT")),U,4)<33,$P($$CPT^ABMCVAPI(ABM,ABMP("VDT")),U,4)'=31 Q  ;CSV-c
  1.  .S ABM("X0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),27,ABM,0)
  1.  .S ABMF(55)=ABMF(55)_"^"_$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,2)  ;CSV-c
  1.  .S ABMF(55)=ABMF(55)_"^"_$$HDTO^ABMDUTL(+^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
  1.  .S ABMU("TXT")=ABMU("TXT")_", "_$P($$CPT^ABMCVAPI($P(ABM("X0"),U),ABMP("VDT")),U,3)  ;CSV-c
  1.  Q
  1.  ;
  1. 57 ; Provider Info
  1.  S ABM="" F ABM("I")=6:1:7 S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABM)) Q:ABM=""  S ABM("X")=$O(^(ABM,"")) D
  1.  .D SELBILL^ABMDE4X
  1.  .I $L(ABM("PNUM")_" "_$P(ABM(ABM),U))<23 S $P(ABMF(57),U,ABM("I"))=ABM("PNUM")_" "_$P(ABM(ABM),U) Q
  1.  .S $P(ABMF(57),U,ABM("I"))=$P(ABM(ABM),U)
  1.  .S $P(ABMF(56),U,ABM("I")-5)=ABM("PNUM")
  1.  ;
  1. RACE ;BLOCK #27     
  1.  ;S ABM("INSTYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) I ABM("INSTYP")]"","RD"[ABM("INSTYP") D  ;abm*2.6*10 HEAT73780
  1.  S ABM("INSTYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  I ABM("INSTYP")]"","RD"[ABM("INSTYP") D  ;abm*2.6*10 HEAT73780
  1.  .S ABM("RACE")=$S($P(^AUPNPAT(ABMP("PDFN"),11),U,11)=1:"I",1:"U")
  1.  .S (ABM("COM"),ABM("RES"))=0 F  S ABM("RES")=$O(^AUPNPAT(ABMP("PDFN"),51,ABM("RES"))) Q:'ABM("RES")  S ABM("COM")=$P(^(ABM("RES"),0),U,3)
  1.  .G XIT:'ABM("COM") S ABM("COM")=$P($G(^AUTTCOM(ABM("COM"),0)),U,2) G XIT:'ABM("COM") S ABM("COM")=$P(^AUTTCTY(ABM("COM"),0),U,3)
  1.  .S $P(ABMF(8),U,17)=ABM("RACE")_"/"_ABM("COM")
  1.  .I ABM("INSTYP")="D" D
  1.  ..S ABM("MCDFN")=$O(^AUPNMCD("B",ABMP("PDFN"),0)) Q:'ABM("MCDFN")
  1.  ..Q:$P($G(^AUPNMCD(ABM("MCDFN"),0)),"^",4)'=6
  1.  ..S $P(ABMF(8),"^",17)=$P(^AUPNMCD(ABM("MCDFN"),0),"^",3)
  1.  ;
  1. XIT K ABM,ABMV,ABMX
  1.  Q
  1.  ;
  1. PXTXT S ABMU("TXT")=$P(ABMU("TXT"),", ",2,99)
  1.  I $L(ABMU("TXT"))>41 S ABMU("LNG")=22,ABMU("TAB")=19,ABMU=2 D LNG^ABMDWRAP S $P(ABMF(54),U)=ABMU(1),$P(ABMF(55),U,2)=ABMU(2) K ABMU I 1
  1.  E  S $P(ABMF(55),U,2)=ABMU("TXT")
  1.  Q