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

DGMTUB.m

Go to the documentation of this file.
  1. DGMTUB ;ALB/RMO/CAW,CPM,LBD,HM - Means Test Billing Utilities ;7/22/02 9:32am
  1. ;;5.3;Registration;**33,456,481,972**;Aug 13, 1993;Build 80
  1. ;
  1. BIL(DFN,DGDT) ;Determine if patient is pending adjudication
  1. ; or category C and has agreed to pay the deductible
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date/Time
  1. ; Output -- 1=TRUE and 0=FALSE
  1. ;
  1. ; Supported ICR #643: Supports use of BIL^DGMTUB(DFN,DGDT) to set the award date
  1. ; for a veteran who is MOH recipient
  1. ;
  1. N MT0,MTI,TDAT,EDAT,BILL,STOP
  1. S (BILL,STOP)=0
  1. I '$G(DFN) G BILQ
  1. S:'$G(DGDT) DGDT=DT
  1. ;
  1. S TDAT=-(DGDT+.1)
  1. F S TDAT=$O(^DGMT(408.31,"AID",1,DFN,TDAT)) Q:'TDAT!STOP D
  1. .S MTI=0 F S MTI=$O(^DGMT(408.31,"AID",1,DFN,TDAT,MTI)) Q:'MTI!STOP D
  1. ..S MT0=$G(^DGMT(408.31,MTI,0)) Q:'$G(^("PRIM")) ; not primary MT
  1. ..;
  1. ..; - evaluate the test if the category isn't 'REQUIRED'
  1. ..I MT0,$P(MT0,"^",3)'=1 D
  1. ...S EDAT=$S($P(MT0,"^",3)=3:+MT0,1:$P(MT0,"^",7))
  1. ...;
  1. ...; - if the patient is not billable on the evaluation date, quit
  1. ...I EDAT\1=(DGDT\1),'$$CK(MT0) S STOP=1 Q
  1. ...;
  1. ...; - if MOH indicator is yes, quit
  1. ...I $P($G(^DPT(DFN,.54)),U)="Y" S STOP=1 Q ; DG*5.3*972 HM
  1. ...;
  1. ...; - if the test effective date is prior to the evaluation date,
  1. ...; obtain the billable status and quit
  1. ...I EDAT'>DGDT S BILL=$$CK(MT0),STOP=1
  1. ;
  1. BILQ Q BILL
  1. ;
  1. BILST(DFN) ;Determine the last date patient was pending adjudication
  1. ; or category C and agreed to pay the deductible
  1. ; Input -- DFN Patient IEN
  1. ; Output -- Last effective date
  1. N DGDT,DGENDT,DGMT0,DGMTI,DGMTIDT,DGSTDT
  1. S (DGDT,DGENDT,DGSTDT)=""
  1. I '$G(DFN) G BILSTQ
  1. I $$BIL(DFN,DT) S DGDT=DT G BILSTQ
  1. ;
  1. S DGMTIDT="" F S DGMTIDT=$O(^DGMT(408.31,"AID",1,DFN,DGMTIDT)) Q:DGMTIDT=""!(DGDT) D
  1. .S DGMTI=0 F S DGMTI=$O(^DGMT(408.31,"AID",1,DFN,DGMTIDT,DGMTI)) Q:DGMTI=""!(DGDT) D
  1. ..I $D(^DGMT(408.31,DGMTI,0)),$G(^("PRIM")) S DGMT0=^(0) D CKDT
  1. ;
  1. BILSTQ Q +$P($G(DGDT),".")
  1. ;
  1. CKDT ;Check the date of test
  1. N DGMTS,X,X1,X2,Y
  1. S Y=$$CK(DGMT0) S DGMTS=$P(DGMT0,"^",3) S:Y DGSTDT=$P(DGMT0,"^",7) S:'Y DGENDT=$S(DGMTS=1:DGENDT,DGMTS=3:$P(DGMT0,"^"),1:$P(DGMT0,"^",7))
  1. I DGSTDT S:'DGENDT DGDT=DT I DGENDT S X1=DGENDT,X2=-1 D C^%DTC S DGDT=X
  1. Q
  1. ;
  1. CK(DGMT0) ;Check if patient is pending adjudication or category C
  1. ; and has agreed to pay the deductible
  1. ; Add check for GMT status (DG*5.3*456)
  1. ; Input -- DGMT0 Annual Means Test 0th node
  1. ; Output -- 1=TRUE and 0=FALSE
  1. N DGMTATP,DGMTS,Y
  1. S DGMTS=$P(DGMT0,"^",3),DGMTATP=$P(DGMT0,"^",11)
  1. I ("^2^6^16^"[("^"_DGMTS_"^"))&(DGMTATP'=0) S Y=1
  1. Q +$G(Y)
  1. ;
  1. GMT(DFN,DGDT) ;Determine if patient is GMT Copay Required as of the date
  1. ; specified
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date/Time
  1. ; Output -- 1=Patient had GMT status or Pending Adjudication
  1. ; for GMT as of date specified
  1. ; 0=Patient did not have GMT status
  1. ;
  1. N DGMT,DGSTA,DGMT0,DGMTG
  1. I '$G(DFN) Q 0
  1. S:'$G(DGDT) DGDT=DT
  1. ; Get last primary means test with status other than Required
  1. S DGMT=$$LVMT^DGMTU(DFN,DGDT),DGSTA=$P(DGMT,U,4)
  1. I DGSTA="G" Q 1 ; status = GMT copay required
  1. S DGMT0=$G(^DGMT(408.31,+DGMT,0)),DGMTG=$P(DGMT0,U,27)
  1. I DGMTG="" Q 0
  1. ; If status = Pending Adjudication and GMT Threhold is greater than
  1. ; MT Threshold, then patient is Pending Adjudication for GMT
  1. I DGSTA="P",DGMTG>$P(DGMT0,U,12) Q 1
  1. Q 0