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

ABMDF11W.m

Go to the documentation of this file. 
  1. ABMDF11W ; IHS/ASDST/DMJ - PRINT UB92 ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ; Original;LSL; June 20, 1997
  1.  ;
  1.  ; IHS/ASDS/LSL - 04/05/00 - V2.4 Patch 1 - NOIS NCA-0300-180046
  1.  ;     Moved PROV to this routine because patching in ABMDF11Z
  1.  ;     resulted in exceeding maximum routine size allowed.
  1.  ;     If medicaid, look for payor assigned provider number in the NEW
  1.  ;     PERSON File before looking at MEDICAID NUMBER in the NEW PERSON
  1.  ;     File.
  1.  ;
  1.  ; IHS/ASDS/SDH - 09/27/01 - V2.4 Patch 9 - NOIS XAA-0901-200095
  1.  ;     After moving Kidscare to Page 5 from Page 7 found that there are
  1.  ;     checks that are done for Medicaid that should also be done for
  1.  ;     Kidscare.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p8 - IM13944
  1.  ;    Print credentials.
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  Q
  1.  ;
  1. WRT ; EP
  1.  ; Write data element in requested format
  1.  S ABMTAB=+$P(ABMDE,"^",2)+ABMP("LM")
  1.  I $P(ABMDE,"^",3)["R" S $P(ABMDE,"^")=$J($P(ABMDE,"^"),+$P(ABMDE,"^",3))
  1.  S ABMDE=$E($P(ABMDE,"^"),1,+$P(ABMDE,"^",3))
  1.  S:ABMTAB+$L(ABMDE)>IOM ABMDE=$E(ABMDE,1,IOM-ABMTAB)
  1.  W ?ABMTAB,ABMDE
  1.  Q
  1.  ;
  1. TEST ; EP
  1.  ; Test Alignment
  1.  S ABMP("LM")=$P(^ABMDEXP(11,0),"^",2)
  1.  N I
  1.  F I=1:1:4 D
  1.  .W !
  1.  .S ABMDE="XXXXX BLOCK 1 LINE "_I_" XXXXX"_"^^25"
  1.  .D WRT
  1.  .I I=2 D
  1.  ..S ABMDE="XXXXXXXXXXXXXXXXXXXXX"_"^57^20"
  1.  ..D WRT
  1.  ..S ABMDE="XXX"_"^78^3"
  1.  ..D WRT
  1.  ..Q
  1.  N I
  1.  F I=1:1:14 W !
  1.  S ABMDE=" 100 ALL INCL R&B/ANC"_"^^29"
  1.  D WRT
  1.  S ABMDE="450.00 ^30^9R"
  1.  D WRT
  1.  S ABMDE=3_"^47^7R"
  1.  D WRT
  1.  S ABMDE=135000_" ^55^10R"
  1.  D WRT
  1.  W $$EN^ABMVDF("IOF")
  1.  Q
  1.  ;
  1. PROV ;EP - PROVIDER INFORMATION
  1.  ;  ABM("PRV",#) = UPIN/MCD #_Provider Name ^ UPIN/MCD# ^
  1.  ;                 Provider State Liscence Number
  1.  S ABMPRVTP=0               ; Initialize Provider Type 
  1.  S ABMPCNT=0                ; Initialize Provider Count 
  1.  F  S ABMPRVTP=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP)) Q:ABMPRVTP=""  D
  1.  .S ABMPRVNO=0             ; Initialize Provider number
  1.  .F  S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO)) Q:'ABMPRVNO  D
  1.  ..; NEW PERSON file IEN
  1.  ..S ABMPRV=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0),"^",1)
  1.  ..S ABMPCNT=ABMPCNT+1     ; Increment provider count
  1.  ..Q:ABMPCNT>3             ; only 1st 3 providers
  1.  ..S ABM("PRV",ABMPCNT)=$P($G(^VA(200,ABMPRV,20)),"^",2)  ; Provider name
  1.  ..S $P(ABM("PRV",ABMPCNT),U,2)=""
  1.  ..; If Medicare FI, find provider UPIN
  1.  ..I ABMP("ITYPE")="R" D
  1.  ...S ABMUPIN=$P($G(^VA(200,ABMPRV,9999999)),"^",8)
  1.  ...S:ABMUPIN="" ABMUPIN="PHS000"
  1.  ...S $P(ABM("PRV",ABMPCNT),U,2)=ABMUPIN
  1.  ..;If Medicaid FI, get MCD Number
  1.  ..I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
  1.  ...S $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999.18,+ABMP("INS"),0)),U,2)
  1.  ...S:$P(ABM("PRV",ABMPCNT),U,2)="" $P(ABM("PRV",ABMPCNT),U,2)=$P($G(^VA(200,ABMPRV,9999999)),U,7)
  1.  ..S:$P(ABM("PRV",ABMPCNT),"^",2)]"" $P(ABM("PRV",ABMPCNT),"^")=$P(ABM("PRV",ABMPCNT),"^",2)_"  "_$P(ABM("PRV",ABMPCNT),"^")
  1.  ..S ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)  ; state IEN
  1.  ..S:ABMVST="" ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
  1.  ..S $P(ABM("PRV",ABMPCNT),"^",3)=$$SLN^ABMERUTL(ABMPRV,ABMVST)  ; Provider State License number
  1.  Q