- 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
