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

ABMDRSU2.m

Go to the documentation of this file. 
  1. ABMDRSU2 ; IHS/ASDST/DMJ - Summarized Claim Display-PART 2 ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
  1.  ;Original;TMD;
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - updated DX^ABMCVAPI call to be numeric
  1.  ;
  1. GPRV ;
  1.  K ABMX
  1.  S ABM(0)=""
  1.  F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM(0))) Q:ABM(0)=""  S ABMX(0)=$O(^(ABM(0),"")) D  S ABMX(ABM)=ABM("X")
  1.  .S ABM("X")=""
  1.  .S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABMX(0),0)),U)
  1.  .Q:ABMX(0)=""
  1.  .Q:'$D(^VA(200,ABMX(0)))
  1.  .N X0
  1.  .S X0=$P($G(^VA(200,ABMX(0),"PS")),U,5)
  1.  .I X0="" S ABM("ERR")=ABM("ERR")+1,ABM("ERR",ABM("ERR"))="Provider: "_$P(^VA(200,ABMX(0),0),U)_" does not have a PROVIDER DISCIPLINE entry" Q
  1.  .S ABMX(0)=X0
  1.  .Q:'$D(^DIC(7,ABMX(0),0))  S ABM("X")=$E($P(^(0),U,1),1,16)
  1.  .Q
  1.  ;
  1.  I '$D(ABMX(1)) S ABMX(1)="no providers"
  1. GPOV ;
  1.  S ABM(0)=""
  1.  F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM(0))) Q:ABM(0)=""  S ABMX(0)=$O(^(ABM(0),"")) D CHKPOV S $P(ABMX(ABM),U,2)=ABM("X")
  1.  I $P(ABMX(1),U,2)="" S $P(ABMX(1),U,2)="no primary DX"
  1.  G GPRC
  1.  ;
  1. CHKPOV ;
  1.  S ABM("X")=""
  1.  S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMX(0),0)),U)
  1.  Q:ABMX(0)=""
  1.  ;Q:'$D(^ICD9(ABMX(0),0))  S ABM("X")=$E($P($$DX^ABMCVAPI(ABMX(0),""),U,4),1,28)  ;abm*2.6*14 update API call
  1.  Q:'$D(^ICD9(ABMX(0),0))  S ABM("X")=$E($P($$DX^ABMCVAPI(+ABMX(0),""),U,4),1,28)  ;abm*2.6*14 update API call
  1.  Q
  1.  ;
  1. GPRC ;
  1.  S ABM(0)=""
  1.  F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM(0))) Q:ABM(0)=""  S ABMX(0)=$O(^(ABM(0),"")) D CHKPRC S $P(ABMX(ABM),U,3)=ABM("X")
  1.  I $P(ABMX(1),U,3)="" S $P(ABMX(1),U,3)="no procedures"
  1.  G PWRT
  1.  ;
  1. CHKPRC ;
  1.  S ABM("X")=""
  1.  S ABMX(0)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABMX(0),0)),U)
  1.  Q:ABMX(0)=""
  1.  Q:'$D(^ICD0(ABMX(0),0))  S ABM("X")=$E($P($$ICDOP^ABMCVAPI(ABMX(0),""),U,5),1,27)  ;CSV-c
  1.  Q
  1.  ;
  1. PWRT ;
  1.  S ABM=0
  1.  F  S ABM=$O(ABMX(ABM)) Q:ABM=""
  1.  I $Y>(IOSL-(8+ABM)) S ABM("CONT")="" D HEAD^ABMDRSU1 Q:$D(ABMP("QUIT"))  D HD^ABMDRSU1
  1.  W !!?4,"ICD Diagnosis",?34,"Procedure Narrative",?63,"Provider Class"
  1.  W !,?4,"----------------------------",?34,"---------------------------",?63,"----------------"
  1.  S ABM=0
  1.  F  S ABM=$O(ABMX(ABM)) Q:ABM=""  D WRT Q:$D(ABMP("QUIT"))
  1.  I $D(ABMP("QUIT")) G XIT
  1.  G GINS
  1.  ;
  1. WRT ;
  1.  W !?4,$P(ABMX(ABM),U,2),?34,$P(ABMX(ABM),U,3),?63,$P(ABMX(ABM),U)
  1.  Q
  1.  ;
  1. GINS ;
  1.  K ABMX
  1.  S ABM(0)=0
  1.  F ABM=1:1 S ABM(0)=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0))) Q:'ABM(0)  S ABM("INSCO")=$P(^(ABM(0),0),U) D CHKINS S ABMX(ABM)=ABM("X")
  1.  G IWRT
  1.  ;
  1. CHKINS ;
  1.  S ABM("X")=""
  1.  Q:'$D(^AUTNINS(ABM("INSCO"),0))  S ABM("X")=$E($P(^(0),U),1,30)
  1.  ;
  1. COV ;
  1.  S ABM("G")=0,ABM("C")=""
  1.  F  S ABM("G")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),11,ABM("G"))) Q:'ABM("G")  S ABM("C")=$S(ABM("C")]"":ABM("C")_";"_$P(^AUTTPIC(ABM("G"),0),U),1:$P(^AUTTPIC(ABM("G"),0),U))
  1.  S $P(ABM("X"),U,2)=ABM("C")
  1.  S $P(ABM("X"),U,4)=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM(0),0),U,3)="F":"FLAGGED",$P(^(0),U,3)="U":"BILLED",$P(^(0),U,3)="I":"ACTIVE",$P(^(0),U,3)="C":"COMPLETED",1:"PENDING")
  1.  Q
  1.  ;
  1. IWRT ;
  1.  S ABM=0
  1.  F  S ABM=$O(ABMX(ABM)) Q:ABM=""
  1.  I $Y>(IOSL-(4+ABM)) S ABM("CONT")="" D HEAD^ABMDRSU1 Q:$D(ABMP("QUIT"))  D HD^ABMDRSU1
  1.  W !!,?4,"Insurance Company",?38,"Coverage Types",?68,"Status"
  1.  W !?4 F I=1:1:75 W "-"
  1.  S ABM=0
  1.  F  S ABM=$O(ABMX(ABM)) Q:ABM=""  D IWRT1 Q:$D(ABMP("QUIT"))
  1.  I $D(ABMP("QUIT")) G XIT
  1.  I $Y'>(IOSL-10) W !!!,ABM("80E")
  1.  K ABMX
  1.  Q
  1.  ;
  1. IWRT1 ;
  1.  W !?4,$P(ABMX(ABM),U,1),?40,$P(ABMX(ABM),U,2),?42,$P(ABMX(ABM),U,3),?68,$P(ABMX(ABM),U,4)
  1.  Q
  1.  ;
  1. XIT Q