- 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 Jan 18, 2025@03:46:21 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