DG53426U ;ALB/AEG - DG*5.3*426 POST-INSTALL UTILITIES ;2-13-02
;;5.3;Registration;**426,1015**;2-13-02;Build 21
;
; This routine contains a number of APIs/Utilities to be
; used in the post-installation cleanup of patch DG*5.3*426
;
MTDA(DFN) ;Set up a data array of each patient's primary means test
; data.
;INPUT - DFN (REQUIRED)
;OUTPUT - NONE -- SET UP MEANS TEST DATA ON TMP GLOBAL
; ^TMP($J,"MTD",DFN)=DGMTI_"~~"_DGNODE
N DGDT,DGIDT,DGMTI,DGMTST,DGNODE,DGCS,DGMTDT
S (DGMTI,DGMTDT)=""
F S DGMTDT=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT)) Q:'DGMTDT D
.F DGMTI=0:0 S DGMTI=$O(^DGMT(408.31,"AD",1,DFN,DGMTDT,DGMTI)) Q:'DGMTI D
..S DGNODE=$G(^DGMT(408.31,DGMTI,0)),DGCS=$P($G(DGNODE),U,3)
..I $G(DGNODE),$G(^("PRIM")) D
...D:((DGCS=6)!(DGCS=2))
....; Only store the last test which meets the criteria for
....; this cleanup.
....S ^TMP($J,"MTD",DFN)=DGMTI_"~~"_DGNODE
....Q
...Q
..Q
.Q
Q
AGTP(DGMTI) ; This API will determine if the patient declined to provide
;; income info but agreed to pay the deductible for a given
; test OR if the veteran provided income information and agreed
; to pay the deductible.
;
; input - DGMTI - IEN of file 408.31 entry
; output - DGRETV - 1 = YES, Vet provided income info & Agreed to
; pay deductible.
; 2 = NO, Vet did not provide income info &
; Agreed to pay.
; 3 = NO, Vet did not provide income info & did
; not agree to pay (Ineligible)
; 4 = YES, Vet provided income info & did NOT
; Agree to pay.
; 0 = Error condition indicated.
N DGRETV
S DGRETV=0
I '$D(^DGMT(408.31,DGMTI,0)) Q DGRETV
I $D(^DGMT(408.31,DGMTI,0)) D
.; Did not decline to provide income info & Agreed to Pay.
.I '+$P($G(^DGMT(408.31,DGMTI,0)),U,14)&+$P($G(^DGMT(408.31,DGMTI,0)),U,11) D
..; Determine age of test and assign to appropriate sub-category
..; - If test date is greater than 10/5/99 - subcategory "a"
..; - If test date is less than 10/6/99 - subcategory "b"
..I $P($G(^DGMT(408.31,DGMTI,0)),U)>2991005 S DGRETV="1a"
..I $P($G(^DGMT(408.31,DGMTI,0)),U)<2991006 S DGRETV="1b"
.; Did NOT provide income info but Agreed to pay. NO date restrictions
.; on these veterans.
.I +$P($G(^DGMT(408.31,DGMTI,0)),U,14)&+$P($G(^DGMT(408.31,DGMTI,0)),U,11) S DGRETV=2
.; Did NOT provide income info & did NOT Agree to pay. (Not eligible)
.I +$P($G(^DGMT(408.31,DGMTI,0)),U,14)&'+$P($G(^DGMT(408.31,DGMTI,0)),U,11) S DGRETV=3
.; Did provide income info but did NOT agree to pay deductible.
.I '+$P($G(^DGMT(408.31,DGMTI,0)),U,14)&'+$P($G(^DGMT(408.31,DGMTI,0)),U,11) S DGRETV=4
Q DGRETV
MM(XMZ) ; Write mail message to user screen and/or install file.
D BMES^XPDUTL("Mail Message < #"_XMZ_" > sent.")
Q
DG53426U ;ALB/AEG - DG*5.3*426 POST-INSTALL UTILITIES ;2-13-02
+1 ;;5.3;Registration;**426,1015**;2-13-02;Build 21
+2 ;
+3 ; This routine contains a number of APIs/Utilities to be
+4 ; used in the post-installation cleanup of patch DG*5.3*426
+5 ;
MTDA(DFN) ;Set up a data array of each patient's primary means test
+1 ; data.
+2 ;INPUT - DFN (REQUIRED)
+3 ;OUTPUT - NONE -- SET UP MEANS TEST DATA ON TMP GLOBAL
+4 ; ^TMP($J,"MTD",DFN)=DGMTI_"~~"_DGNODE
+5 NEW DGDT,DGIDT,DGMTI,DGMTST,DGNODE,DGCS,DGMTDT
+6 SET (DGMTI,DGMTDT)=""
+7 FOR
SET DGMTDT=$ORDER(^DGMT(408.31,"AD",1,DFN,DGMTDT))
IF 'DGMTDT
QUIT
Begin DoDot:1
+8 FOR DGMTI=0:0
SET DGMTI=$ORDER(^DGMT(408.31,"AD",1,DFN,DGMTDT,DGMTI))
IF 'DGMTI
QUIT
Begin DoDot:2
+9 SET DGNODE=$GET(^DGMT(408.31,DGMTI,0))
SET DGCS=$PIECE($GET(DGNODE),U,3)
+10 IF $GET(DGNODE)
IF $GET(^("PRIM"))
Begin DoDot:3
+11 IF ((DGCS=6)!(DGCS=2))
Begin DoDot:4
+12 ; Only store the last test which meets the criteria for
+13 ; this cleanup.
+14 SET ^TMP($JOB,"MTD",DFN)=DGMTI_"~~"_DGNODE
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
AGTP(DGMTI) ; This API will determine if the patient declined to provide
+1 ;; income info but agreed to pay the deductible for a given
+2 ; test OR if the veteran provided income information and agreed
+3 ; to pay the deductible.
+4 ;
+5 ; input - DGMTI - IEN of file 408.31 entry
+6 ; output - DGRETV - 1 = YES, Vet provided income info & Agreed to
+7 ; pay deductible.
+8 ; 2 = NO, Vet did not provide income info &
+9 ; Agreed to pay.
+10 ; 3 = NO, Vet did not provide income info & did
+11 ; not agree to pay (Ineligible)
+12 ; 4 = YES, Vet provided income info & did NOT
+13 ; Agree to pay.
+14 ; 0 = Error condition indicated.
+15 NEW DGRETV
+16 SET DGRETV=0
+17 IF '$DATA(^DGMT(408.31,DGMTI,0))
QUIT DGRETV
+18 IF $DATA(^DGMT(408.31,DGMTI,0))
Begin DoDot:1
+19 ; Did not decline to provide income info & Agreed to Pay.
+20 IF '+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,14)&+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,11)
Begin DoDot:2
+21 ; Determine age of test and assign to appropriate sub-category
+22 ; - If test date is greater than 10/5/99 - subcategory "a"
+23 ; - If test date is less than 10/6/99 - subcategory "b"
+24 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),U)>2991005
SET DGRETV="1a"
+25 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),U)<2991006
SET DGRETV="1b"
End DoDot:2
+26 ; Did NOT provide income info but Agreed to pay. NO date restrictions
+27 ; on these veterans.
+28 IF +$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,14)&+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,11)
SET DGRETV=2
+29 ; Did NOT provide income info & did NOT Agree to pay. (Not eligible)
+30 IF +$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,14)&'+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,11)
SET DGRETV=3
+31 ; Did provide income info but did NOT agree to pay deductible.
+32 IF '+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,14)&'+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,11)
SET DGRETV=4
End DoDot:1
+33 QUIT DGRETV
MM(XMZ) ; Write mail message to user screen and/or install file.
+1 DO BMES^XPDUTL("Mail Message < #"_XMZ_" > sent.")
+2 QUIT
