- DG53294A ;ALB/RTK - Means Test Utilities ;10/20/00
- ;;5.3;Registration;**294**;Aug 13, 1993
- ;
- ;This routine will edit the newly added ELIGIBILITY VERIF.
- ;SOURCE (.3613) field of the PATIENT (#2) file to populate it
- ;for use with new logic that is being implemented as part of
- ;the Ineligible project. The source will be set as follows:
- ;
- ;If the ELIGIBILITY VERIF. METHOD (.3615) is VIVA, and the
- ;entity verifying (.3616) is POSTMASTER, the source field
- ;will be set to HEC.
- ;
- ;All other patient records with an existing eligibility node
- ;(.361) will be set to HEC.
- ;
- EN N DATA,LFDATE,DFN,I,X,X1,X2,%
- S (ERRMSG,FILERR)=""
- I $D(XPDNM) D
- .I $$VERCP^XPDUTL("LFDATE")'>0 D
- ..S %=$$NEWCP^XPDUTL("LFDATE","","0")
- .I $$VERCP^XPDUTL("DFN")'>0 D
- ..S %=$$NEWCP^XPDUTL("DFN","","0")
- ;
- F I="SRCREC","SRCSET","SRCERR" D
- .I $D(^XTMP("DG-"_I)) Q
- .S X1=DT
- .S X2=30
- .D C^%DTC
- .S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*294 POST-INSTALL "_$S(I="SRCREC":"record count",I="SRCSET":"records corrected",1:"filing errors")
- ;
- I '$D(XPDNM) S (^XTMP("DG-SRCREC",1),^XTMP("DG-SRCSET",1))=0
- I $D(XPDNM)&'$D(^XTMP("DG-SRCREC",1)) S ^XTMP("DG-SRCREC",1)=0
- I $D(XPDNM)&'$D(^XTMP("DG-SRCSET",1)) S ^XTMP("DG-SRCSET",1)=0
- I $D(XPDNM) S %=$$VERCP^XPDUTL("LFDATE")
- I $G(%)="" S %=0
- I %=0 D EN1
- Q
- EN1 I '$D(XPDNM) S LFDATE=""
- I $D(XPDNM) S LFDATE=$$PARCP^XPDUTL("LFDATE")
- S DFN="",RECSET=0
- F S LFDATE=$O(^DPT("B",LFDATE)) Q:LFDATE="" D
- .F S DFN=$O(^DPT("B",LFDATE,DFN)) Q:DFN="" D
- ..I '$D(^DPT(DFN,0)) S FILERR(2,DFN,"ALL")="Patient record "_DFN_" does not exist." M ^XTMP("DG-SRCERR")=FILERR K FILERR Q
- ..I $D(^DPT(DFN,.361)) D
- ...S ^XTMP("DG-SRCREC",1)=$G(^XTMP("DG-SRCREC",1))+1
- ...I $P(^DPT(DFN,.361),U,5)["VIVA",($P(^DPT(DFN,.361),U,6)=.5) D
- ....S DATA(.3613)="H",RECSET=1 I $$UPD^DGENDBS(2,DFN,.DATA) S ^XTMP("DG-SRCSET",1)=$G(^XTMP("DG-SRCSET",1))+1
- ...I $P(^DPT(DFN,.361),U,5)'["VIVA"!($P(^DPT(DFN,.361),U,6)'=.5) D
- ....S DATA(.3613)="V",RECSET=1 I $$UPD^DGENDBS(2,DFN,.DATA) S ^XTMP("DG-SRCSET",1)=$G(^XTMP("DG-SRCSET",1))+1
- ...I 'RECSET S FILERR(2,DFN,"ALL")="Unable to edit patient record "_DFN_"." Q
- ...S RECSET=0
- ..I $G(FILERR) M ^XTMP("DG-SRCERR")=FILERR K FILERR
- ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DFN",DFN)
- .I $D(XPDNM) S %=$$UPCP^XPDUTL("LFDATE",LFDATE)
- D MAIL^DG53294M
- I $D(XPDNM) S %=$$COMCP^XPDUTL("LFDATE")
- D BMES^XPDUTL(" ELIGIBILITY VERIF. SOURCE edit process is complete.")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53294A 2493 printed Feb 19, 2025@00:03:06 Page 2
- DG53294A ;ALB/RTK - Means Test Utilities ;10/20/00
- +1 ;;5.3;Registration;**294**;Aug 13, 1993
- +2 ;
- +3 ;This routine will edit the newly added ELIGIBILITY VERIF.
- +4 ;SOURCE (.3613) field of the PATIENT (#2) file to populate it
- +5 ;for use with new logic that is being implemented as part of
- +6 ;the Ineligible project. The source will be set as follows:
- +7 ;
- +8 ;If the ELIGIBILITY VERIF. METHOD (.3615) is VIVA, and the
- +9 ;entity verifying (.3616) is POSTMASTER, the source field
- +10 ;will be set to HEC.
- +11 ;
- +12 ;All other patient records with an existing eligibility node
- +13 ;(.361) will be set to HEC.
- +14 ;
- EN NEW DATA,LFDATE,DFN,I,X,X1,X2,%
- +1 SET (ERRMSG,FILERR)=""
- +2 IF $DATA(XPDNM)
- Begin DoDot:1
- +3 IF $$VERCP^XPDUTL("LFDATE")'>0
- Begin DoDot:2
- +4 SET %=$$NEWCP^XPDUTL("LFDATE","","0")
- End DoDot:2
- +5 IF $$VERCP^XPDUTL("DFN")'>0
- Begin DoDot:2
- +6 SET %=$$NEWCP^XPDUTL("DFN","","0")
- End DoDot:2
- End DoDot:1
- +7 ;
- +8 FOR I="SRCREC","SRCSET","SRCERR"
- Begin DoDot:1
- +9 IF $DATA(^XTMP("DG-"_I))
- QUIT
- +10 SET X1=DT
- +11 SET X2=30
- +12 DO C^%DTC
- +13 SET ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*294 POST-INSTALL "_$S(I="SRCREC":"record count",I="SRCSET":"records corrected",1:"filing errors")
- End DoDot:1
- +14 ;
- +15 IF '$DATA(XPDNM)
- SET (^XTMP("DG-SRCREC",1),^XTMP("DG-SRCSET",1))=0
- +16 IF $DATA(XPDNM)&'$DATA(^XTMP("DG-SRCREC",1))
- SET ^XTMP("DG-SRCREC",1)=0
- +17 IF $DATA(XPDNM)&'$DATA(^XTMP("DG-SRCSET",1))
- SET ^XTMP("DG-SRCSET",1)=0
- +18 IF $DATA(XPDNM)
- SET %=$$VERCP^XPDUTL("LFDATE")
- +19 IF $GET(%)=""
- SET %=0
- +20 IF %=0
- DO EN1
- +21 QUIT
- EN1 IF '$DATA(XPDNM)
- SET LFDATE=""
- +1 IF $DATA(XPDNM)
- SET LFDATE=$$PARCP^XPDUTL("LFDATE")
- +2 SET DFN=""
- SET RECSET=0
- +3 FOR
- SET LFDATE=$ORDER(^DPT("B",LFDATE))
- if LFDATE=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET DFN=$ORDER(^DPT("B",LFDATE,DFN))
- if DFN=""
- QUIT
- Begin DoDot:2
- +5 IF '$DATA(^DPT(DFN,0))
- SET FILERR(2,DFN,"ALL")="Patient record "_DFN_" does not exist."
- MERGE ^XTMP("DG-SRCERR")=FILERR
- KILL FILERR
- QUIT
- +6 IF $DATA(^DPT(DFN,.361))
- Begin DoDot:3
- +7 SET ^XTMP("DG-SRCREC",1)=$GET(^XTMP("DG-SRCREC",1))+1
- +8 IF $PIECE(^DPT(DFN,.361),U,5)["VIVA"
- IF ($PIECE(^DPT(DFN,.361),U,6)=.5)
- Begin DoDot:4
- +9 SET DATA(.3613)="H"
- SET RECSET=1
- IF $$UPD^DGENDBS(2,DFN,.DATA)
- SET ^XTMP("DG-SRCSET",1)=$GET(^XTMP("DG-SRCSET",1))+1
- End DoDot:4
- +10 IF $PIECE(^DPT(DFN,.361),U,5)'["VIVA"!($PIECE(^DPT(DFN,.361),U,6)'=.5)
- Begin DoDot:4
- +11 SET DATA(.3613)="V"
- SET RECSET=1
- IF $$UPD^DGENDBS(2,DFN,.DATA)
- SET ^XTMP("DG-SRCSET",1)=$GET(^XTMP("DG-SRCSET",1))+1
- End DoDot:4
- +12 IF 'RECSET
- SET FILERR(2,DFN,"ALL")="Unable to edit patient record "_DFN_"."
- QUIT
- +13 SET RECSET=0
- End DoDot:3
- +14 IF $GET(FILERR)
- MERGE ^XTMP("DG-SRCERR")=FILERR
- KILL FILERR
- +15 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("DFN",DFN)
- End DoDot:2
- +16 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("LFDATE",LFDATE)
- End DoDot:1
- +17 DO MAIL^DG53294M
- +18 IF $DATA(XPDNM)
- SET %=$$COMCP^XPDUTL("LFDATE")
- +19 DO BMES^XPDUTL(" ELIGIBILITY VERIF. SOURCE edit process is complete.")
- +20 QUIT
