DGMTUB ;ALB/RMO/CAW,CPM,LBD,HM - Means Test Billing Utilities ;7/22/02 9:32am
;;5.3;Registration;**33,456,481,972**;Aug 13, 1993;Build 80
;
BIL(DFN,DGDT) ;Determine if patient is pending adjudication
; or category C and has agreed to pay the deductible
; Input -- DFN Patient IEN
; DGDT Date/Time
; Output -- 1=TRUE and 0=FALSE
;
; Supported ICR #643: Supports use of BIL^DGMTUB(DFN,DGDT) to set the award date
; for a veteran who is MOH recipient
;
N MT0,MTI,TDAT,EDAT,BILL,STOP
S (BILL,STOP)=0
I '$G(DFN) G BILQ
S:'$G(DGDT) DGDT=DT
;
S TDAT=-(DGDT+.1)
F S TDAT=$O(^DGMT(408.31,"AID",1,DFN,TDAT)) Q:'TDAT!STOP D
.S MTI=0 F S MTI=$O(^DGMT(408.31,"AID",1,DFN,TDAT,MTI)) Q:'MTI!STOP D
..S MT0=$G(^DGMT(408.31,MTI,0)) Q:'$G(^("PRIM")) ; not primary MT
..;
..; - evaluate the test if the category isn't 'REQUIRED'
..I MT0,$P(MT0,"^",3)'=1 D
...S EDAT=$S($P(MT0,"^",3)=3:+MT0,1:$P(MT0,"^",7))
...;
...; - if the patient is not billable on the evaluation date, quit
...I EDAT\1=(DGDT\1),'$$CK(MT0) S STOP=1 Q
...;
...; - if MOH indicator is yes, quit
...I $P($G(^DPT(DFN,.54)),U)="Y" S STOP=1 Q ; DG*5.3*972 HM
...;
...; - if the test effective date is prior to the evaluation date,
...; obtain the billable status and quit
...I EDAT'>DGDT S BILL=$$CK(MT0),STOP=1
;
BILQ Q BILL
;
BILST(DFN) ;Determine the last date patient was pending adjudication
; or category C and agreed to pay the deductible
; Input -- DFN Patient IEN
; Output -- Last effective date
N DGDT,DGENDT,DGMT0,DGMTI,DGMTIDT,DGSTDT
S (DGDT,DGENDT,DGSTDT)=""
I '$G(DFN) G BILSTQ
I $$BIL(DFN,DT) S DGDT=DT G BILSTQ
;
S DGMTIDT="" F S DGMTIDT=$O(^DGMT(408.31,"AID",1,DFN,DGMTIDT)) Q:DGMTIDT=""!(DGDT) D
.S DGMTI=0 F S DGMTI=$O(^DGMT(408.31,"AID",1,DFN,DGMTIDT,DGMTI)) Q:DGMTI=""!(DGDT) D
..I $D(^DGMT(408.31,DGMTI,0)),$G(^("PRIM")) S DGMT0=^(0) D CKDT
;
BILSTQ Q +$P($G(DGDT),".")
;
CKDT ;Check the date of test
N DGMTS,X,X1,X2,Y
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))
I DGSTDT S:'DGENDT DGDT=DT I DGENDT S X1=DGENDT,X2=-1 D C^%DTC S DGDT=X
Q
;
CK(DGMT0) ;Check if patient is pending adjudication or category C
; and has agreed to pay the deductible
; Add check for GMT status (DG*5.3*456)
; Input -- DGMT0 Annual Means Test 0th node
; Output -- 1=TRUE and 0=FALSE
N DGMTATP,DGMTS,Y
S DGMTS=$P(DGMT0,"^",3),DGMTATP=$P(DGMT0,"^",11)
I ("^2^6^16^"[("^"_DGMTS_"^"))&(DGMTATP'=0) S Y=1
Q +$G(Y)
;
GMT(DFN,DGDT) ;Determine if patient is GMT Copay Required as of the date
; specified
; Input -- DFN Patient IEN
; DGDT Date/Time
; Output -- 1=Patient had GMT status or Pending Adjudication
; for GMT as of date specified
; 0=Patient did not have GMT status
;
N DGMT,DGSTA,DGMT0,DGMTG
I '$G(DFN) Q 0
S:'$G(DGDT) DGDT=DT
; Get last primary means test with status other than Required
S DGMT=$$LVMT^DGMTU(DFN,DGDT),DGSTA=$P(DGMT,U,4)
I DGSTA="G" Q 1 ; status = GMT copay required
S DGMT0=$G(^DGMT(408.31,+DGMT,0)),DGMTG=$P(DGMT0,U,27)
I DGMTG="" Q 0
; If status = Pending Adjudication and GMT Threhold is greater than
; MT Threshold, then patient is Pending Adjudication for GMT
I DGSTA="P",DGMTG>$P(DGMT0,U,12) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTUB 3556 printed Oct 16, 2024@18:46:19 Page 2
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
+2 ;
BIL(DFN,DGDT) ;Determine if patient is pending adjudication
+1 ; or category C and has agreed to pay the deductible
+2 ; Input -- DFN Patient IEN
+3 ; DGDT Date/Time
+4 ; Output -- 1=TRUE and 0=FALSE
+5 ;
+6 ; Supported ICR #643: Supports use of BIL^DGMTUB(DFN,DGDT) to set the award date
+7 ; for a veteran who is MOH recipient
+8 ;
+9 NEW MT0,MTI,TDAT,EDAT,BILL,STOP
+10 SET (BILL,STOP)=0
+11 IF '$GET(DFN)
GOTO BILQ
+12 if '$GET(DGDT)
SET DGDT=DT
+13 ;
+14 SET TDAT=-(DGDT+.1)
+15 FOR
SET TDAT=$ORDER(^DGMT(408.31,"AID",1,DFN,TDAT))
if 'TDAT!STOP
QUIT
Begin DoDot:1
+16 SET MTI=0
FOR
SET MTI=$ORDER(^DGMT(408.31,"AID",1,DFN,TDAT,MTI))
if 'MTI!STOP
QUIT
Begin DoDot:2
+17 ; not primary MT
SET MT0=$GET(^DGMT(408.31,MTI,0))
if '$GET(^("PRIM"))
QUIT
+18 ;
+19 ; - evaluate the test if the category isn't 'REQUIRED'
+20 IF MT0
IF $PIECE(MT0,"^",3)'=1
Begin DoDot:3
+21 SET EDAT=$SELECT($PIECE(MT0,"^",3)=3:+MT0,1:$PIECE(MT0,"^",7))
+22 ;
+23 ; - if the patient is not billable on the evaluation date, quit
+24 IF EDAT\1=(DGDT\1)
IF '$$CK(MT0)
SET STOP=1
QUIT
+25 ;
+26 ; - if MOH indicator is yes, quit
+27 ; DG*5.3*972 HM
IF $PIECE($GET(^DPT(DFN,.54)),U)="Y"
SET STOP=1
QUIT
+28 ;
+29 ; - if the test effective date is prior to the evaluation date,
+30 ; obtain the billable status and quit
+31 IF EDAT'>DGDT
SET BILL=$$CK(MT0)
SET STOP=1
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
BILQ QUIT BILL
+1 ;
BILST(DFN) ;Determine the last date patient was pending adjudication
+1 ; or category C and agreed to pay the deductible
+2 ; Input -- DFN Patient IEN
+3 ; Output -- Last effective date
+4 NEW DGDT,DGENDT,DGMT0,DGMTI,DGMTIDT,DGSTDT
+5 SET (DGDT,DGENDT,DGSTDT)=""
+6 IF '$GET(DFN)
GOTO BILSTQ
+7 IF $$BIL(DFN,DT)
SET DGDT=DT
GOTO BILSTQ
+8 ;
+9 SET DGMTIDT=""
FOR
SET DGMTIDT=$ORDER(^DGMT(408.31,"AID",1,DFN,DGMTIDT))
if DGMTIDT=""!(DGDT)
QUIT
Begin DoDot:1
+10 SET DGMTI=0
FOR
SET DGMTI=$ORDER(^DGMT(408.31,"AID",1,DFN,DGMTIDT,DGMTI))
if DGMTI=""!(DGDT)
QUIT
Begin DoDot:2
+11 IF $DATA(^DGMT(408.31,DGMTI,0))
IF $GET(^("PRIM"))
SET DGMT0=^(0)
DO CKDT
End DoDot:2
End DoDot:1
+12 ;
BILSTQ QUIT +$PIECE($GET(DGDT),".")
+1 ;
CKDT ;Check the date of test
+1 NEW DGMTS,X,X1,X2,Y
+2 SET Y=$$CK(DGMT0)
SET DGMTS=$PIECE(DGMT0,"^",3)
if Y
SET DGSTDT=$PIECE(DGMT0,"^",7)
if 'Y
SET DGENDT=$SELECT(DGMTS=1:DGENDT,DGMTS=3:$PIECE(DGMT0,"^"),1:$PIECE(DGMT0,"^",7))
+3 IF DGSTDT
if 'DGENDT
SET DGDT=DT
IF DGENDT
SET X1=DGENDT
SET X2=-1
DO C^%DTC
SET DGDT=X
+4 QUIT
+5 ;
CK(DGMT0) ;Check if patient is pending adjudication or category C
+1 ; and has agreed to pay the deductible
+2 ; Add check for GMT status (DG*5.3*456)
+3 ; Input -- DGMT0 Annual Means Test 0th node
+4 ; Output -- 1=TRUE and 0=FALSE
+5 NEW DGMTATP,DGMTS,Y
+6 SET DGMTS=$PIECE(DGMT0,"^",3)
SET DGMTATP=$PIECE(DGMT0,"^",11)
+7 IF ("^2^6^16^"[("^"_DGMTS_"^"))&(DGMTATP'=0)
SET Y=1
+8 QUIT +$GET(Y)
+9 ;
GMT(DFN,DGDT) ;Determine if patient is GMT Copay Required as of the date
+1 ; specified
+2 ; Input -- DFN Patient IEN
+3 ; DGDT Date/Time
+4 ; Output -- 1=Patient had GMT status or Pending Adjudication
+5 ; for GMT as of date specified
+6 ; 0=Patient did not have GMT status
+7 ;
+8 NEW DGMT,DGSTA,DGMT0,DGMTG
+9 IF '$GET(DFN)
QUIT 0
+10 if '$GET(DGDT)
SET DGDT=DT
+11 ; Get last primary means test with status other than Required
+12 SET DGMT=$$LVMT^DGMTU(DFN,DGDT)
SET DGSTA=$PIECE(DGMT,U,4)
+13 ; status = GMT copay required
IF DGSTA="G"
QUIT 1
+14 SET DGMT0=$GET(^DGMT(408.31,+DGMT,0))
SET DGMTG=$PIECE(DGMT0,U,27)
+15 IF DGMTG=""
QUIT 0
+16 ; If status = Pending Adjudication and GMT Threhold is greater than
+17 ; MT Threshold, then patient is Pending Adjudication for GMT
+18 IF DGSTA="P"
IF DGMTG>$PIECE(DGMT0,U,12)
QUIT 1
+19 QUIT 0
