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

ABMDRPX.m

Go to the documentation of this file. 
  1. ABMDRPX ; IHS/ASDST/DMJ - CPT Summary Report ; 
  1.  ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
  1.  ;Original;TMD;10/20/95 3:37 PM
  1.  ;
  1.  ; IHS/SD/SDR - 10/21/02 - V2.5 P2 - UXX-1002-170028
  1.  ;      Modified so report would print data second time if same session
  1.  ;
  1.  ; IHS/SD/SDR - v2.6 CSV
  1.  ; IHS/SD/SDR - abm*2.6*1 - HEAT4716 - Include NDC on RXs
  1.  ;
  1.  K ABM,ABMY,^TMP("ABM-PX","CL")
  1.  K ^TMP($J,"ABM-PX","CL")
  1.  ;
  1. SEL ;
  1.  ; Ask the user what category they would like to list procedures
  1.  W !!,"----- PROCEDURE CATEGORIES -----",!
  1.  K DIR
  1.  S DIR(0)="SO^1:MEDICAL;2:SURGICAL;3:RADIOLOGY;4:LABORATORY;5:ANESTHESIA;6:DENTAL;7:ROOM & BOARD;8:MISCELLANEOUS (HCPCS);9:PHARMACY;10:ALL"
  1.  S DIR("A")="Select Desired CATEGORY"
  1.  D ^DIR
  1.  G XIT:$D(DIROUT)!$D(DIRUT)
  1.  S ABM("CAT")=Y(0)
  1.  S ABM=+Y
  1.  ;ABM("SUB") ; multiple in bill file         
  1.  S ABM("SUB")=$S(ABM=1:27,ABM=2:21,ABM=3:35,ABM=4:37,ABM=5:39,ABM=6:33,ABM=7:25,ABM=8:43,ABM=9:23,1:"")
  1.  I ABM("SUB")="" S ABM("ALL")=1
  1.  ;
  1. RSEL ;
  1.  ; Select exclusion parameters
  1.  D ^ABMDRSEL
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ;
  1. HD ;
  1.  S ABM("HDCAT")=$S(ABM=1:"MEDICAL ",ABM=2:"SURGICAL ",ABM=3:"RADIOLOGY ",ABM=4:"LABORATORY ",ABM=5:"ANESTHESIA ",ABM=6:"DENTAL ",ABM=7:"ROOM & BOARD ",ABM=8:"MISCELLANEOUS (HCPCS) ",ABM=9:"PHARMACY ",1:"")
  1.  S ABM("HD",0)="BILLED "_ABM("HDCAT")_"PROCEDURES"
  1.  D ^ABMDRHD                        ; Write report header
  1.  S ABMQ("RC")="COMPUTE^ABMDRPX"    ; Compute routine
  1.  S ABMQ("RP")="PRINT^ABMDRPX1"     ; Print routine
  1.  S ABMQ("RX")="POUT^ABMDRUTL"      ; Namespace
  1.  S ABMQ("NS")="ABM"
  1.  D ^ABMDRDBQ                       ; Double queue rtn - uses ABMQ array
  1.  Q
  1.  ;
  1. COMPUTE ;EP - Entry Point for Setting up Data
  1.  ; Loop through bill file
  1.  S ABM("SUBR")="ABM-PX"
  1.  K ^TMP(ABM("SUBR"),$J)
  1.  S ABMP("RTN")="ABMDRPX"
  1.  D LOOP^ABMDRUTL
  1.  Q
  1.  ;
  1. DATA ;
  1.  ; for each bill. . . gather data (called from ABMDRUTL)
  1.  S ABMP("HIT")=0
  1.  D ^ABMDRCHK   ; Check bill parameters
  1.  Q:'ABMP("HIT")
  1.  S ABM("CL")=+^ABMDBILL(DUZ(2),ABM,0)
  1.  Q:$D(^TMP($J,"ABM-PX","CL",ABM("CL")))
  1.  S ^TMP($J,"ABM-PX","CL",ABM("CL"))=""
  1.  I +ABM("SUB") D ONE
  1.  I $G(ABM("ALL")) D
  1.  .F ABM("SUB")=21,23,25,27,33,35,37,39,43 D
  1.  ..I $O(^ABMDBILL(DUZ(2),ABM,ABM("SUB"),0)) D ONE
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABM,8)),U,10),'$D(ABMY("PX")) D
  1.  ..S ABM("FEE")=$P(^ABMDBILL(DUZ(2),ABM,8),U,10)
  1.  ..S ABM("CD")=450
  1.  ..S ABM("NM")=$P(^AUTTREVN(ABM("CD"),0),U,2)
  1.  ..D TL
  1.  .I $P($G(^ABMDBILL(DUZ(2),ABM,9)),U,8),'$D(ABMY("PX")) D
  1.  ..S ABM("FEE")=$P(^ABMDBILL(DUZ(2),ABM,9),U,8)
  1.  ..S ABM("CD")=$P(^ABMDBILL(DUZ(2),ABM,9),U,7)
  1.  ..S ABM("NM")=$P(^AUTTREVN(ABM("CD"),0),U,2)
  1.  ..D TL
  1.  Q
  1.  ;
  1. ONE ;
  1.  ; ONE CATEGORY
  1.  I $D(ABMY("PX")),"23^25^33^43"[ABM("SUB") Q
  1.  S ABM("PX")=0
  1.  F  S ABM("PX")=$O(^ABMDBILL(DUZ(2),ABM,ABM("SUB"),ABM("PX"))) Q:'ABM("PX")  D
  1.  .Q:'$D(^ABMDBILL(DUZ(2),ABM,ABM("SUB"),ABM("PX"),0))
  1.  .S ABM(0)=^ABMDBILL(DUZ(2),ABM,ABM("SUB"),ABM("PX"),0)
  1.  .;S ABM("CD")=$S(ABM("SUB")=23:"ZZZZZ",ABM("SUB")=25:+ABM(0),ABM("SUB")=33:$P(^AUTTADA(+ABM(0),0),U),1:$P($$CPT^ABMCVAPI(+ABM(0),ABM("D")),U,2))  ;CSV-c  ;abm*2.6*1 HEAT4716
  1.  .S ABM("CD")=$S(ABM("SUB")=23:$P($G(ABM(0)),U,24),ABM("SUB")=25:+ABM(0),ABM("SUB")=33:$P(^AUTTADA(+ABM(0),0),U),1:$P($$CPT^ABMCVAPI(+ABM(0),ABM("D")),U,2))  ;CSV-c  ;abm*2.6*1 HEAT4716
  1.  .I +ABM("CD")<+$G(ABMY("PX",1)) Q
  1.  .I $D(ABMY("PX",2)),+ABM("CD")>+ABMY("PX",2) Q
  1.  .;S ABM("NM")=$S(ABM("SUB")=23:"PRESCRIPTIONS",ABM("SUB")=25:$E($P(^AUTTREVN(+ABM(0),0),U,2),1,40),ABM("SUB")=33:$E($P(^AUTTADA(+ABM(0),0),U,2),1,40),1:$P($$CPT^ABMCVAPI(+ABM(0),ABM("D")),U,3))  ;CSV-c  ;abm*2.6*1 HEAT4716
  1.  .;start new code abm*2.6*1 HEAT4716
  1.  .S ABM("NM")=$S(ABM("SUB")=23&(ABM("CD")'=""):$E($P(^PSDRUG(+ABM(0),0),U),1,30),ABM("SUB")=25:$E($P(^AUTTREVN(+ABM(0),0),U,2),1,40),ABM("SUB")=33:$E($P(^AUTTADA(+ABM(0),0),U,2),1,40),1:$P($$CPT^ABMCVAPI(+ABM(0),ABM("D")),U,3))  ;CSV-c
  1.  .I ABM("SUB")=23&(ABM("CD")="") S ABM("NM")="PRESCRIPTIONS"
  1.  .;end new code HEAT4716
  1.  .I ABM("SUB")=21 S ABM("FEE")=$P(ABM(0),U,7)
  1.  .I ABM("SUB")=23 S ABM("FEE")=$P(ABM(0),U,3)*$P(ABM(0),U,4)+$P(ABM(0),U,5)
  1.  .I ABM("SUB")=25 S ABM("FEE")=$P(ABM(0),U,2)*$P(ABM(0),U,3)
  1.  .I ABM("SUB")=27 S ABM("FEE")=$P(ABM(0),U,3)*$P(ABM(0),U,4)
  1.  .I ABM("SUB")=33 S ABM("FEE")=$P(ABM(0),U,8)
  1.  .I ABM("SUB")=35!(ABM("SUB")=37)!(ABM("SUB")=43) S ABM("FEE")=$P(ABM(0),U,3)*$P(ABM(0),U,4)
  1.  .I ABM("SUB")=39 D
  1.  ..S ABM("FEE")=$P(ABM(0),U,3)+$P(ABM(0),U,4)
  1.  ..S ABM("CD")=ABM("CD")_".1"
  1.  ..Q:'$G(ABM("ALL"))
  1.  ..S ABM("NM")=ABM("NM")_" (ANEST)"
  1.  .I ABM("CD")=""&(ABM("SUB")=23) S ABM("CD")="NONDC-"  ;abm*2.6*1 HEAT4716
  1.  .D TL
  1.  Q
  1.  ;
  1. TL ;
  1.  ;SET ENTRY IN TMP
  1.  S $P(^TMP("ABM-PX",$J),U)=$P($G(^TMP("ABM-PX",$J)),U)+1
  1.  S $P(^TMP("ABM-PX",$J),U,2)=$P(^TMP("ABM-PX",$J),U,2)+ABM("FEE")
  1.  S $P(^TMP("ABM-PX",$J,ABM("CD")),U)=$P($G(^TMP("ABM-PX",$J,ABM("CD"))),U)+1,$P(^(ABM("CD")),U,2)=$P(^(ABM("CD")),U,2)+ABM("FEE"),$P(^(ABM("CD")),U,3)=ABM("NM")
  1.  Q
  1.  ;
  1. XIT ;
  1.  K ABM,ABMY,ABMP
  1.  Q