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

ABMDESMC.m

Go to the documentation of this file.
ABMDESMC ; IHS/ASDST/DMJ - Ambulatory Surg Claim Info ;
 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009
 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
 ;
 K ABMS("CPT"),ABMS("TMP")
 S ABMCAT=21 D PCK^ABMDESM1 Q:$G(ABMQUIT)
 I $P($G(^AUTNINS(ABMP("INS"),2)),U)'="R" S ABMS("TOT")=0
MS S ABMX="""""" F ABMS=1:1 S ABMX=$O(@(ABMP("GL")_"21,""C"","_ABMX_")")) Q:'ABMX  S ABMX("X")=$O(^(ABMX,"")) D MS1
 G XIT
 ;
MS1 S ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)")
 ;Q:'$P($G(^ABMDFEE(ABMP("FEE"),11,+ABMX(0),0)),U,2)  ;abm*2.6*2 3PMS10003A
 Q:'$P($$ONE^ABMFEAPI(ABMP("FEE"),11,+ABMX(0),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
 I $D(ABMS("TMP",+ABMX(0))) S $P(ABMS("CPT",ABMS("TMP",+ABMX(0))),U,4)=$P(ABMS("CPT",ABMS("TMP",+ABMX(0))),U,4)+1,ABMS=ABMS-1 Q
 S ABMS("CPT",ABMS)=U_$P(ABMX(0),U)_U_$P(ABMP("FLAT"),U,2)_U_1
 S ABMS("TMP",$P(ABMX(0),U))=ABMS
 I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R" G MCR
 ;S $P(ABMS("CPT",ABMS),U,5)=$P(^ABMDFEE(ABMP("FEE"),11,+ABMX(0),0),U,2),ABMS("TOT")=ABMS("TOT")+$P(^(0),U,2)  ;abm*2.6*2 3PMS10003A
 S $P(ABMS("CPT",ABMS),U,5)=$P($$ONE^ABMFEAPI(ABMP("FEE"),11,+ABMX(0),ABMP("VDT")),U),ABMS("TOT")=ABMS("TOT")+$P($$ONE^ABMFEAPI(ABMP("FEE"),11,+ABMX(0),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
 Q
MCR S $P(ABMS("CPT",ABMS),U,5)=$S(ABMS=1:ABMS("TOT"),1:0)
 Q
 ;
XIT K ABMX,ABMS("TMP")
 Q