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

ABMDE0X.m

Go to the documentation of this file. 
  1. ABMDE0X ; IHS/SD/SDR - Set Summary Display Variables ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
  1.  ;
  1.  ;IHS/SD/SDR - v2.5 p8 - task 8 - Modified to check for replacement insurer to display
  1.  ;
  1.  ;IHS/SD/SDR - v2.6 CSV
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Made change for display of provider narrative to use DIQ call so new output transform on field will be executed.
  1.  ; *********************************************************************
  1. IDEN ; EP
  1.  S ABM(1)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)
  1.  S ABM("CLN")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,6)
  1.  S ABM(2)=$S(ABM("CLN")]"":$P($G(^DIC(40.7,ABM("CLN"),0)),U,1),1:"")
  1.  S ABM(3)=$E($P(^ABMDVTYP($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7),0),U),1,26)
  1.  S ABM(4)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
  1.  S ABM(5)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)
  1.  S ABM(4)=$$HDT^ABMDUTL(ABM(4))
  1.  S ABM(5)=$$HDT^ABMDUTL(ABM(5))
  1.  ;
  1. INS ;
  1.  S ABM=""
  1.  F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM  D
  1.  .S Y=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
  1.  .S ABM("I"_ABM("I")_"S")="  "_$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,3)="I":"ACTIVE",$P(^(0),U,3)="C":"COMPLETE",$P(^(0),U,3)="B":"BILLED",$P(^(0),U,3)="U":"UNBILABL",1:"PENDING")
  1.  .S Y=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0)),U,11)'="":$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,11),1:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U))
  1.  .S ABM("I"_ABM("I"))=$P(^AUTNINS(Y,0),U)
  1.  ;
  1. QUES ;
  1.  S ABM("CNT1")=7+ABM("I")
  1.  D W1^ABMDE30
  1.  D W2^ABMDE30
  1.  S ABM("RELS")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y":"YES",1:"NO")
  1.  S ABM("ASGN")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",1:"NO")
  1.  S ABM("EMRG")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,5)="Y":"YES",1:"NO")
  1.  S ABM("EMPL")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,1)="Y":"YES",1:"NO")
  1.  S ABM("PROG")="NO"
  1.  I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10 D
  1.  .S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
  1.  .I ABM("X")]"" D
  1.  ..S ABM("X")=^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0)
  1.  ..I $D(^ABMDCODE(ABM("X"),0)) D
  1.  ...S ABM("PROG")="YES"
  1.  ...S ABM("CNT1")=ABM("CNT1")+.5
  1.  S ABM("ACC")="NO"
  1.  I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)]""!($P($G(^(8)),U,3)]"") D
  1.  .S ABM("ACC")="YES"
  1.  .S ABM("CNT1")=ABM("CNT1")+.5
  1.  I ABM("EMRG")="YES" S ABM("CNT1")=ABM("CNT1")+.5
  1.  I ABM("EMPL")="YES" S ABM("CNT1")=ABM("CNT1")+.5
  1.  S ABM("CNT1")=ABM("CNT1")+.5
  1.  S ABM("CNT1")=$P(ABM("CNT1"),".")
  1.  ;
  1. PRV ;
  1.  K ABM("A"),ABM("O")
  1.  S (ABM("CNT2"),ABM("CNT3"))=1
  1.  S ABM=""
  1.  F  S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM)) Q:ABM=""  S ABM("X")=$O(^(ABM,"")),ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0) Q:$P(ABM("X0"),U,2)=""  D
  1.  .I '$D(^VA(200,+ABM("X0"),0)) D  Q
  1.  ..S DA(1)=ABMP("CDFN")
  1.  ..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",41,"
  1.  ..S DA=ABM("X")
  1.  ..D ^DIK
  1.  .S ABM($P(ABM("X0"),U,2))=$P(^VA(200,$P(ABM("X0"),U),0),U)
  1.  S ABM("OPRV")=$S($D(ABM("O")):ABM("O"),1:"")
  1.  I ABM("OPRV")]"" D
  1.  .S ABM("CNT2")=ABM("CNT2")+1
  1.  .S ABM("CNT3")=ABM("CNT3")+1
  1.  S ABM("APRV")=$S($D(ABM("A")):ABM("A"),1:"")
  1.  I ABM("OPRV")]"" D
  1.  .S ABM("CNT2")=ABM("CNT2")+1
  1.  .S ABM("CNT3")=ABM("CNT3")+1
  1.  ;
  1. DX ;
  1.  G DDS:ABMP("VTYP")=998&'$D(ABMP("FLAT"))
  1.  S ABM=""
  1.  ;F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:ABM=""  S Y=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$O(^(ABM,"")),0)),U,3) I Y]"" S ABM("D"_ABM("I"))=$E($G(^AUTNPOV(Y,0)),1,34)  ;abm*2.6*14 HEAT161263
  1.  ;start new code abm*2.6*14 HEAT161263
  1.  F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:ABM=""  D
  1.  .S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM,0))
  1.  .Q:ABMI=""
  1.  .S IENS=ABMI_","_ABMP("CDFN")_","
  1.  .S Y=$$GET1^DIQ(9002274.3017,IENS,".03","E")
  1.  .I Y]"" S ABM("D"_ABM("I"))=$E(Y,1,34)
  1.  ;end new code HEAT161263
  1.  S ABM("CNT2")=ABM("CNT2")+ABM("I")
  1.  ;
  1.  D ^ABMDE0X1
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. DDS ;
  1.  S ABM=0
  1.  F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM)) Q:'ABM  D
  1.  .S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM,0),U)
  1.  .S ABM("P"_ABM("I"))=$E($P($G(^AUTTADA(Y,0)),U,2),1,34)
  1.  S ABM("CNT2")=ABM("CNT2")+ABM("I")
  1.  S ABM=0
  1.  F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM)) Q:'ABM  D
  1.  .S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,0),U)
  1.  .S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)  ;CSV-c
  1.  S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
  1.  S ABM=0
  1.  F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM)) Q:'ABM  D
  1.  .S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM,0),U)
  1.  .S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)  ;CSV-c
  1.  S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
  1.  ;
  1. XIT ;
  1.  Q