DGMSRPT1 ;ALB/LBD,BRM - Military Service Inconsistency Report; 01/05/04 ; 5/18/04 9:53am
;;5.3;Registration;**562,603,1015**; Aug 13,1993;Build 21
;
; This routine scans the Patient file #2 and checks military service
; data for inconsistencies. The inconsistencies are stored in
; ^XTMP("DSMSRPT").
Q
EN ; Entry point called from ^DGMSRPT
; Initialize ^XTMP global and set start date
S ^XTMP("DGMSRPT",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"DG MILITARY SERVICE INCONSISTENCY REPORT"
S $P(^XTMP("DGMSRPT","DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
S:$G(ZTSK) ZTREQ="@"
D INIT^DGMSRPT
; Loop through Patient file #2. If patient meets report criteria, check
; military service data for inconsistencies.
N DFN
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN I $$CHK(DFN) D MSINC(DFN)
; Send message containing inconsistency counts, update stop date/time
S $P(^XTMP("DGMSRPT","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
D MSG^DGMSRPT(DGXTMP)
K ^XTMP("DGMSRPT","RUNNING"),DGXTMP
Q
CHK(DFN) ; Check if patient meets criteria to include in report
; OUTPUT: 1=Meets report criteria; 0=Doesn't meet report criteria
N CHK,ENR,ENRDT,UE,UESITE,SITE
S CHK=0 I '$G(DFN) Q CHK
; Patient is a veteran
I $P($G(^DPT(DFN,"VET")),U)'="Y" Q CHK
; Patient not deceased
I +$G(^DPT(DFN,.35)) Q CHK
; Primary eligibility not 'Humanitarian Emergency', 'Sharing Agreement',
; or 'Employee'
I "^8^9^14^"[(U_+$G(^DPT(DFN,.36))_U) Q CHK
; User Enrollee of this facility
S UE=$P($G(^DPT(DFN,.361)),U,7) I UE="" Q CHK
S UESITE=$P($G(^DPT(DFN,.361)),U,8) I +UESITE=0 Q CHK
S SITE=$P($$SITE^VASITE,U,3),SITE=$$PSITE^EASUER(SITE)
I $P($G(^DIC(4,UESITE,99)),U)'=$P($G(^DIC(4,SITE,99)),U) Q CHK
; Has a current enrollment record
I '$G(^DPT(DFN,"ENR")) Q CHK
; Meets report criteria
S CHK=1
Q CHK
MSINC(DFN) ; Check military service data for inconsistencies.
N DGMS,NAM,SSN
Q:'$G(DFN)
; Get veteran's military service data
D GETMS(DFN,.DGMS)
; Check Military Service Episodes
D MSECHK(DFN,.DGMS)
; Check Combat and POW data
D CMPWCHK(DFN,.DGMS)
; Check Conflict data
D CONFCHK(DFN,.DGMS)
; If inconsistencies were found, add 0 node and x-refs
I $D(@DGXTMP@(DFN)) D
.S NAM=$P($G(^DPT(DFN,0)),U,1),SSN=$P($G(^DPT(DFN,0)),U,9)
.S @DGXTMP@(DFN,0)=NAM_U_SSN
.I NAM'="" S @DGXTMP@("NAM",NAM,DFN)=""
.I SSN'="" S @DGXTMP@("SSN",+$E(SSN,8,9),+$E(SSN,6,9),+SSN,DFN)=""
.D SETCNT("VET")
Q
GETMS(DFN,DGMS) ; Build DGMS array of military service data
; OUTPUT: DGMS(CATEGORY,FIELD) - array of Military Service data
N MS,I,CAT,FLD
Q:'$G(DFN)
F I=.32,.321,.322,.52 S MS(I)=$G(^DPT(DFN,I))
S CAT="MSE1^MSE2^MSE3",FLD="DIS^BOS^FDT^TDT^NUM"
D ARRY(CAT,FLD,.32,4,18,.MS,.DGMS)
I $P(MS(.32),U,19)'="Y" K DGMS("MSE2") ;Delete data for inactive MSE
I $P(MS(.32),U,20)'="Y" K DGMS("MSE3") ;Delete data for inactive MSE
S CAT="LEB^GREN^PAN^GULF",FLD="IND^FDT^TDT"
D ARRY(CAT,FLD,.322,1,12,.MS,.DGMS)
S CAT="SOM^YUG"
D ARRY(CAT,FLD,.322,16,21,.MS,.DGMS)
S CAT="VIET",FLD="IND"
D ARRY(CAT,FLD,.321,1,1,.MS,.DGMS)
S FLD="FDT^TDT"
D ARRY(CAT,FLD,.321,4,5,.MS,.DGMS)
S CAT="POW",FLD="IND^LOC^FDT^TDT"
D ARRY(CAT,FLD,.52,5,8,.MS,.DGMS)
S CAT="COM"
D ARRY(CAT,FLD,.52,11,14,.MS,.DGMS)
Q
ARRY(CAT,FLD,SB,P1,P2,MS,DGMS) ; Set array
; INPUT: CAT - MS categories (e.g. MSE1 = 1st Military Service Episode)
; FLD - MS fields (e.g. FDT = From Date, TDT = To Date)
; SB - MS array subscript
; P1 - Starting piece in MS string
; P2 - Ending piece in MS string
; MS( - Array with MS data from the Patient file
; OUTPUT: DGMS( - Array returned with MS data grouped by category
N I,J,K
S J=1,K=0
F I=P1:1:P2 D
.I K=$L(FLD,U) S J=J+1,K=0
.S K=K+1
.I $P(MS(SB),U,I)'="" S DGMS($P(CAT,U,J),$P(FLD,U,K))=$P(MS(SB),U,I)
Q
MSECHK(DFN,DGMS) ; Check military service episodes for inconsistencies
N DGTXT,CAT,DG,OVR,BOS,WWIIDT,WWIIS,WWIIE
; Is there MSE data for this veteran?
I '$D(DGMS("MSE1")),'$D(DGMS("MSE2")),'$D(DGMS("MSE3")) Q
F CAT="MSE1","MSE2","MSE3" K DGTXT S DG=1 I $D(DGMS(CAT)) D
.; Check Branch of Service (B.E.C. and Merchant Seaman)
.S BOS=+$G(DGMS(CAT,"BOS")),BOS=$P($G(^DIC(23,BOS,0)),U,1)
.I BOS="B.E.C." S DGTXT="BEC" D SETTXT(.DG,.DGTXT),SETCNT(2)
.I BOS="MERCHANT SEAMAN" D
..S WWIIDT=$$GETCNFDT^DGRPDT("WWIIP"),WWIIS=$P(WWIIDT,U),WWIIE=$P(WWIIDT,U,2)
..Q:$$WITHIN^DGRPDT(WWIIS,WWIIE,$G(DGMS(CAT,"FDT")))
..Q:$$WITHIN^DGRPDT(WWIIS,WWIIE,$G(DGMS(CAT,"TDT")))
..Q:$$RWITHIN^DGRPDT($G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),WWIIS,WWIIE)
..S DGTXT="MERC SEA NO WWII SVC" D SETTXT(.DG,.DGTXT),SETCNT(3)
.; Check for missing data
.I $$MISS(CAT,"BOS^DIS^FDT^TDT") S DGTXT="DATA MISS" D SETTXT(.DG,.DGTXT),SETCNT(4)
.; Check for imprecise dates (year only)
.I $$IMPR(CAT,"FDT^TDT") S DGTXT="DT IMPR" D SETTXT(.DG,.DGTXT),SETCNT(5)
.; Check if To Date is before From Date
.I $G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),$$B4^DGRPDT(DGMS(CAT,"TDT"),DGMS(CAT,"FDT")) D
..S DGTXT="END DT BEFORE START DT" D SETTXT(.DG,.DGTXT),SETCNT(6)
.; Check if dates overlap with another MSE
.S OVR=$$OVRLP(CAT) I OVR S DGTXT="DT OVRLP W/ "_$P(OVR,U,2) D SETTXT(.DG,.DGTXT),SETCNT(7)
.;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
.I $D(DGTXT) D SETVET(DFN,CAT,.DGTXT)
Q
CMPWCHK(DFN,DGMS) ; Check Combat and POW data for inconsistencies
; INPUT: DFN - Patient file IEN
; DGMS( - MS data array
N DGTXT,CAT,DG,LOC
F CAT="COM","POW" K DGTXT S DG=1 I $G(DGMS(CAT,"IND"))="Y" D
.; Check for missing data
.I $$MISS(CAT,"FDT^TDT^LOC") S DGTXT="DATA MISS" D SETTXT(.DG,.DGTXT),SETCNT($S(CAT="COM":8,1:16))
.; Check for imprecise dates (year only)
.I $$IMPR(CAT,"FDT^TDT") S DGTXT="DT IMPR" D SETTXT(.DG,.DGTXT),SETCNT($S(CAT="COM":9,1:17))
.; Check if dates are valid for the location
.I $G(DGMS(CAT,"LOC")) S LOC=$$LOC(DGMS(CAT,"LOC")) I LOC'="" D
..Q:$$CNFLCTDT^DGRPDT($G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),LOC)
..S DGTXT="DT INVALID FOR LOC" D SETTXT(.DG,.DGTXT),SETCNT($S(CAT="COM":10,1:18))
.; Check if dates are within a Military Service Episode
.I $G(DGMS(CAT,"FDT"))!($G(DGMS(CAT,"TDT"))) D
..Q:$$OVRLPCHK^DGRPDT(DFN,$G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),-1)
..S DGTXT="DT NOT W/IN MSE" D SETTXT(.DG,.DGTXT),SETCNT($S(CAT="COM":11,1:19))
.;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
.I $D(DGTXT) D SETVET(DFN,CAT,.DGTXT)
Q
CONFCHK(DFN,DGMS) ; Check Conflict data for inconsistencies
N DGTXT,CAT,DG
F CAT="VIET","LEB","GREN","PAN","GULF","SOM","YUG" K DGTXT S DG=1 I $G(DGMS(CAT,"IND"))="Y" D
.; Check for missing data
.I $$MISS(CAT,"FDT^TDT") S DGTXT="DATA MISS" D SETTXT(.DG,.DGTXT),SETCNT(12)
.; Check for imprecise dates (year only)
.I $$IMPR(CAT,"FDT^TDT") S DGTXT="DT IMPR" D SETTXT(.DG,.DGTXT),SETCNT(13)
.; Check if dates are valid for the location
.I $G(DGMS(CAT,"FDT"))!($G(DGMS(CAT,"TDT"))) D
..Q:$$CNFLCTDT^DGRPDT($G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),CAT)
..S DGTXT="DT INVALID FOR LOC" D SETTXT(.DG,.DGTXT),SETCNT(14)
.; Check if dates are within a Military Service Episode
.I $G(DGMS(CAT,"FDT"))!($G(DGMS(CAT,"TDT"))) D
..Q:$$OVRLPCHK^DGRPDT(DFN,$G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),-1)
..S DGTXT="DT NOT W/IN MSE" D SETTXT(.DG,.DGTXT),SETCNT(15)
.;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
.I $D(DGTXT) D SETVET(DFN,CAT,.DGTXT)
Q
SETTXT(DG,DGTXT) ; Set array of MS inconsistency text DGTXT(
; INPUT: DG - Subscript for DGTXT array
Q:'$G(DG)
I $G(DGTXT(DG))="" S DGTXT(DG)=DGTXT Q
I $L(DGTXT(DG)_"; "_DGTXT)>36 S DG=DG+1,DGTXT(DG)=DGTXT Q
S DGTXT(DG)=DGTXT(DG)_"; "_DGTXT
Q
SETVET(DFN,CAT,DGTXT) ; Update ^XTMP("DGMSRPT","MSINC",DFN, with MS inconsistencies for veteran
;
Q:'$G(DFN) Q:'$D(CAT) Q:'$D(DGTXT)
N DG S DG=0
F S DG=$O(DGTXT(DG)) Q:'DG S @DGXTMP@(DFN,CAT,DG)=DGTXT(DG)
Q
SETCNT(SUB) ; Update ^XTMP("DGMSRPT","MSINC","CNT",
; INPUT: SUB - Subscript in ^("CNT") array to increment
Q:$G(SUB)=""
S $P(@DGXTMP@("CNT",SUB),U,1)=+(@DGXTMP@("CNT",SUB))+1
Q
MISS(CAT,FLD) ; Check for missing data elements
; INPUT: CAT - MS category, 1st subscript in DGMS array
; FLD - List of fields to check for missing data
; OUTPUT: 1=Missing data; 0=No missing data
N MISS,I,X
S MISS=0
I $G(CAT)=""!($G(FLD)="") Q MISS
F I=1:1 S X=$P(FLD,U,I) Q:X="" I '$D(DGMS(CAT,X)) S MISS=1 Q
Q MISS
IMPR(CAT,FLD) ; Check for imprecise dates (year only)
; INPUT: CAT - MS category, 1st subscript in DGMS array
; FLD - List of fields to check for imprecise dates
; OUTPUT: 1=Imprecise date; 0=No imprecise date
N IMPR,I,X
S IMPR=0
I $G(CAT)=""!($G(FLD)="") Q IMPR
F I=1:1 S X=$P(FLD,U,I) Q:X="" I $D(DGMS(CAT,X)),'$$MNTHYR^DGRPDT(DGMS(CAT,X)) S IMPR=1 Q
Q IMPR
OVRLP(CAT) ; Check if MSE dates overlap with another MSE
; INPUT: CAT - MS category, 1st subscript in DGMS array
; OUTPUT: 0=No overlap; 1^X=Overlap^MSE that overlaps
N OVR,MSE,DGI,DGX
S OVR=0
I $G(CAT)="" Q OVR
S DGX=$E(CAT,4)
; If MSE1, no check; if MSE2, check overlap with MSE1; if MSE3, check
; overlap with MSE2 or MSE1
F DGI=(DGX-1):-1:1 S MSE="MSE"_DGI I $D(DGMS(MSE)) D Q:OVR
.S OVR=$$WITHIN^DGRPDT($G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),$G(DGMS(MSE,"FDT"))) I OVR S OVR=+OVR_U_MSE Q
.S OVR=$$WITHIN^DGRPDT($G(DGMS(CAT,"FDT")),$G(DGMS(CAT,"TDT")),$G(DGMS(MSE,"TDT"))) I OVR S OVR=+OVR_U_MSE Q
Q OVR
LOC(LN) ; Return conflict location abbreviation to pass to $$CNFLCTDT^DGRPDT
; INPUT: LN - POW Location file #22 IEN
; OUTPUT: Conflict location abbreviation
Q:'$G(LN) ""
S LN=$P($G(^DIC(22,LN,0)),U,1) I LN="" Q ""
Q:LN="WORLD WAR I" "WWI"
Q:LN["EUROPE" "WWIIE"
Q:LN["PACIFIC" "WWIIP"
Q:LN["KOREA" "KOR"
Q:LN["VIETNAM" "VIET"
Q:LN="OTHER" ""
Q:LN["GULF" "GULF"
Q:LN["YUGOSLAVIA" "YUG"
Q ""
DGMSRPT1 ;ALB/LBD,BRM - Military Service Inconsistency Report; 01/05/04 ; 5/18/04 9:53am
+1 ;;5.3;Registration;**562,603,1015**; Aug 13,1993;Build 21
+2 ;
+3 ; This routine scans the Patient file #2 and checks military service
+4 ; data for inconsistencies. The inconsistencies are stored in
+5 ; ^XTMP("DSMSRPT").
+6 QUIT
EN ; Entry point called from ^DGMSRPT
+1 ; Initialize ^XTMP global and set start date
+2 SET ^XTMP("DGMSRPT",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"DG MILITARY SERVICE INCONSISTENCY REPORT"
+3 SET $PIECE(^XTMP("DGMSRPT","DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+4 IF $GET(ZTSK)
SET ZTREQ="@"
+5 DO INIT^DGMSRPT
+6 ; Loop through Patient file #2. If patient meets report criteria, check
+7 ; military service data for inconsistencies.
+8 NEW DFN
+9 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
IF 'DFN
QUIT
IF $$CHK(DFN)
DO MSINC(DFN)
+10 ; Send message containing inconsistency counts, update stop date/time
+11 SET $PIECE(^XTMP("DGMSRPT","DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+12 DO MSG^DGMSRPT(DGXTMP)
+13 KILL ^XTMP("DGMSRPT","RUNNING"),DGXTMP
+14 QUIT
CHK(DFN) ; Check if patient meets criteria to include in report
+1 ; OUTPUT: 1=Meets report criteria; 0=Doesn't meet report criteria
+2 NEW CHK,ENR,ENRDT,UE,UESITE,SITE
+3 SET CHK=0
IF '$GET(DFN)
QUIT CHK
+4 ; Patient is a veteran
+5 IF $PIECE($GET(^DPT(DFN,"VET")),U)'="Y"
QUIT CHK
+6 ; Patient not deceased
+7 IF +$GET(^DPT(DFN,.35))
QUIT CHK
+8 ; Primary eligibility not 'Humanitarian Emergency', 'Sharing Agreement',
+9 ; or 'Employee'
+10 IF "^8^9^14^"[(U_+$GET(^DPT(DFN,.36))_U)
QUIT CHK
+11 ; User Enrollee of this facility
+12 SET UE=$PIECE($GET(^DPT(DFN,.361)),U,7)
IF UE=""
QUIT CHK
+13 SET UESITE=$PIECE($GET(^DPT(DFN,.361)),U,8)
IF +UESITE=0
QUIT CHK
+14 SET SITE=$PIECE($$SITE^VASITE,U,3)
SET SITE=$$PSITE^EASUER(SITE)
+15 IF $PIECE($GET(^DIC(4,UESITE,99)),U)'=$PIECE($GET(^DIC(4,SITE,99)),U)
QUIT CHK
+16 ; Has a current enrollment record
+17 IF '$GET(^DPT(DFN,"ENR"))
QUIT CHK
+18 ; Meets report criteria
+19 SET CHK=1
+20 QUIT CHK
MSINC(DFN) ; Check military service data for inconsistencies.
+1 NEW DGMS,NAM,SSN
+2 IF '$GET(DFN)
QUIT
+3 ; Get veteran's military service data
+4 DO GETMS(DFN,.DGMS)
+5 ; Check Military Service Episodes
+6 DO MSECHK(DFN,.DGMS)
+7 ; Check Combat and POW data
+8 DO CMPWCHK(DFN,.DGMS)
+9 ; Check Conflict data
+10 DO CONFCHK(DFN,.DGMS)
+11 ; If inconsistencies were found, add 0 node and x-refs
+12 IF $DATA(@DGXTMP@(DFN))
Begin DoDot:1
+13 SET NAM=$PIECE($GET(^DPT(DFN,0)),U,1)
SET SSN=$PIECE($GET(^DPT(DFN,0)),U,9)
+14 SET @DGXTMP@(DFN,0)=NAM_U_SSN
+15 IF NAM'=""
SET @DGXTMP@("NAM",NAM,DFN)=""
+16 IF SSN'=""
SET @DGXTMP@("SSN",+$EXTRACT(SSN,8,9),+$EXTRACT(SSN,6,9),+SSN,DFN)=""
+17 DO SETCNT("VET")
End DoDot:1
+18 QUIT
GETMS(DFN,DGMS) ; Build DGMS array of military service data
+1 ; OUTPUT: DGMS(CATEGORY,FIELD) - array of Military Service data
+2 NEW MS,I,CAT,FLD
+3 IF '$GET(DFN)
QUIT
+4 FOR I=.32,.321,.322,.52
SET MS(I)=$GET(^DPT(DFN,I))
+5 SET CAT="MSE1^MSE2^MSE3"
SET FLD="DIS^BOS^FDT^TDT^NUM"
+6 DO ARRY(CAT,FLD,.32,4,18,.MS,.DGMS)
+7 ;Delete data for inactive MSE
IF $PIECE(MS(.32),U,19)'="Y"
KILL DGMS("MSE2")
+8 ;Delete data for inactive MSE
IF $PIECE(MS(.32),U,20)'="Y"
KILL DGMS("MSE3")
+9 SET CAT="LEB^GREN^PAN^GULF"
SET FLD="IND^FDT^TDT"
+10 DO ARRY(CAT,FLD,.322,1,12,.MS,.DGMS)
+11 SET CAT="SOM^YUG"
+12 DO ARRY(CAT,FLD,.322,16,21,.MS,.DGMS)
+13 SET CAT="VIET"
SET FLD="IND"
+14 DO ARRY(CAT,FLD,.321,1,1,.MS,.DGMS)
+15 SET FLD="FDT^TDT"
+16 DO ARRY(CAT,FLD,.321,4,5,.MS,.DGMS)
+17 SET CAT="POW"
SET FLD="IND^LOC^FDT^TDT"
+18 DO ARRY(CAT,FLD,.52,5,8,.MS,.DGMS)
+19 SET CAT="COM"
+20 DO ARRY(CAT,FLD,.52,11,14,.MS,.DGMS)
+21 QUIT
ARRY(CAT,FLD,SB,P1,P2,MS,DGMS) ; Set array
+1 ; INPUT: CAT - MS categories (e.g. MSE1 = 1st Military Service Episode)
+2 ; FLD - MS fields (e.g. FDT = From Date, TDT = To Date)
+3 ; SB - MS array subscript
+4 ; P1 - Starting piece in MS string
+5 ; P2 - Ending piece in MS string
+6 ; MS( - Array with MS data from the Patient file
+7 ; OUTPUT: DGMS( - Array returned with MS data grouped by category
+8 NEW I,J,K
+9 SET J=1
SET K=0
+10 FOR I=P1:1:P2
Begin DoDot:1
+11 IF K=$LENGTH(FLD,U)
SET J=J+1
SET K=0
+12 SET K=K+1
+13 IF $PIECE(MS(SB),U,I)'=""
SET DGMS($PIECE(CAT,U,J),$PIECE(FLD,U,K))=$PIECE(MS(SB),U,I)
End DoDot:1
+14 QUIT
MSECHK(DFN,DGMS) ; Check military service episodes for inconsistencies
+1 NEW DGTXT,CAT,DG,OVR,BOS,WWIIDT,WWIIS,WWIIE
+2 ; Is there MSE data for this veteran?
+3 IF '$DATA(DGMS("MSE1"))
IF '$DATA(DGMS("MSE2"))
IF '$DATA(DGMS("MSE3"))
QUIT
+4 FOR CAT="MSE1","MSE2","MSE3"
KILL DGTXT
SET DG=1
IF $DATA(DGMS(CAT))
Begin DoDot:1
+5 ; Check Branch of Service (B.E.C. and Merchant Seaman)
+6 SET BOS=+$GET(DGMS(CAT,"BOS"))
SET BOS=$PIECE($GET(^DIC(23,BOS,0)),U,1)
+7 IF BOS="B.E.C."
SET DGTXT="BEC"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(2)
+8 IF BOS="MERCHANT SEAMAN"
Begin DoDot:2
+9 SET WWIIDT=$$GETCNFDT^DGRPDT("WWIIP")
SET WWIIS=$PIECE(WWIIDT,U)
SET WWIIE=$PIECE(WWIIDT,U,2)
+10 IF $$WITHIN^DGRPDT(WWIIS,WWIIE,$GET(DGMS(CAT,"FDT")))
QUIT
+11 IF $$WITHIN^DGRPDT(WWIIS,WWIIE,$GET(DGMS(CAT,"TDT")))
QUIT
+12 IF $$RWITHIN^DGRPDT($GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),WWIIS,WWIIE)
QUIT
+13 SET DGTXT="MERC SEA NO WWII SVC"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(3)
End DoDot:2
+14 ; Check for missing data
+15 IF $$MISS(CAT,"BOS^DIS^FDT^TDT")
SET DGTXT="DATA MISS"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(4)
+16 ; Check for imprecise dates (year only)
+17 IF $$IMPR(CAT,"FDT^TDT")
SET DGTXT="DT IMPR"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(5)
+18 ; Check if To Date is before From Date
+19 IF $GET(DGMS(CAT,"FDT"))
IF $GET(DGMS(CAT,"TDT"))
IF $$B4^DGRPDT(DGMS(CAT,"TDT"),DGMS(CAT,"FDT"))
Begin DoDot:2
+20 SET DGTXT="END DT BEFORE START DT"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(6)
End DoDot:2
+21 ; Check if dates overlap with another MSE
+22 SET OVR=$$OVRLP(CAT)
IF OVR
SET DGTXT="DT OVRLP W/ "_$PIECE(OVR,U,2)
DO SETTXT(.DG,.DGTXT)
DO SETCNT(7)
+23 ;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
+24 IF $DATA(DGTXT)
DO SETVET(DFN,CAT,.DGTXT)
End DoDot:1
+25 QUIT
CMPWCHK(DFN,DGMS) ; Check Combat and POW data for inconsistencies
+1 ; INPUT: DFN - Patient file IEN
+2 ; DGMS( - MS data array
+3 NEW DGTXT,CAT,DG,LOC
+4 FOR CAT="COM","POW"
KILL DGTXT
SET DG=1
IF $GET(DGMS(CAT,"IND"))="Y"
Begin DoDot:1
+5 ; Check for missing data
+6 IF $$MISS(CAT,"FDT^TDT^LOC")
SET DGTXT="DATA MISS"
DO SETTXT(.DG,.DGTXT)
DO SETCNT($SELECT(CAT="COM":8,1:16))
+7 ; Check for imprecise dates (year only)
+8 IF $$IMPR(CAT,"FDT^TDT")
SET DGTXT="DT IMPR"
DO SETTXT(.DG,.DGTXT)
DO SETCNT($SELECT(CAT="COM":9,1:17))
+9 ; Check if dates are valid for the location
+10 IF $GET(DGMS(CAT,"LOC"))
SET LOC=$$LOC(DGMS(CAT,"LOC"))
IF LOC'=""
Begin DoDot:2
+11 IF $$CNFLCTDT^DGRPDT($GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),LOC)
QUIT
+12 SET DGTXT="DT INVALID FOR LOC"
DO SETTXT(.DG,.DGTXT)
DO SETCNT($SELECT(CAT="COM":10,1:18))
End DoDot:2
+13 ; Check if dates are within a Military Service Episode
+14 IF $GET(DGMS(CAT,"FDT"))!($GET(DGMS(CAT,"TDT")))
Begin DoDot:2
+15 IF $$OVRLPCHK^DGRPDT(DFN,$GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),-1)
QUIT
+16 SET DGTXT="DT NOT W/IN MSE"
DO SETTXT(.DG,.DGTXT)
DO SETCNT($SELECT(CAT="COM":11,1:19))
End DoDot:2
+17 ;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
+18 IF $DATA(DGTXT)
DO SETVET(DFN,CAT,.DGTXT)
End DoDot:1
+19 QUIT
CONFCHK(DFN,DGMS) ; Check Conflict data for inconsistencies
+1 NEW DGTXT,CAT,DG
+2 FOR CAT="VIET","LEB","GREN","PAN","GULF","SOM","YUG"
KILL DGTXT
SET DG=1
IF $GET(DGMS(CAT,"IND"))="Y"
Begin DoDot:1
+3 ; Check for missing data
+4 IF $$MISS(CAT,"FDT^TDT")
SET DGTXT="DATA MISS"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(12)
+5 ; Check for imprecise dates (year only)
+6 IF $$IMPR(CAT,"FDT^TDT")
SET DGTXT="DT IMPR"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(13)
+7 ; Check if dates are valid for the location
+8 IF $GET(DGMS(CAT,"FDT"))!($GET(DGMS(CAT,"TDT")))
Begin DoDot:2
+9 IF $$CNFLCTDT^DGRPDT($GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),CAT)
QUIT
+10 SET DGTXT="DT INVALID FOR LOC"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(14)
End DoDot:2
+11 ; Check if dates are within a Military Service Episode
+12 IF $GET(DGMS(CAT,"FDT"))!($GET(DGMS(CAT,"TDT")))
Begin DoDot:2
+13 IF $$OVRLPCHK^DGRPDT(DFN,$GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),-1)
QUIT
+14 SET DGTXT="DT NOT W/IN MSE"
DO SETTXT(.DG,.DGTXT)
DO SETCNT(15)
End DoDot:2
+15 ;If inconsistencies found, update ^XTMP("DGMSRPT","MSINC",DFN,
+16 IF $DATA(DGTXT)
DO SETVET(DFN,CAT,.DGTXT)
End DoDot:1
+17 QUIT
SETTXT(DG,DGTXT) ; Set array of MS inconsistency text DGTXT(
+1 ; INPUT: DG - Subscript for DGTXT array
+2 IF '$GET(DG)
QUIT
+3 IF $GET(DGTXT(DG))=""
SET DGTXT(DG)=DGTXT
QUIT
+4 IF $LENGTH(DGTXT(DG)_"; "_DGTXT)>36
SET DG=DG+1
SET DGTXT(DG)=DGTXT
QUIT
+5 SET DGTXT(DG)=DGTXT(DG)_"; "_DGTXT
+6 QUIT
SETVET(DFN,CAT,DGTXT) ; Update ^XTMP("DGMSRPT","MSINC",DFN, with MS inconsistencies for veteran
+1 ;
+2 IF '$GET(DFN)
QUIT
IF '$DATA(CAT)
QUIT
IF '$DATA(DGTXT)
QUIT
+3 NEW DG
SET DG=0
+4 FOR
SET DG=$ORDER(DGTXT(DG))
IF 'DG
QUIT
SET @DGXTMP@(DFN,CAT,DG)=DGTXT(DG)
+5 QUIT
SETCNT(SUB) ; Update ^XTMP("DGMSRPT","MSINC","CNT",
+1 ; INPUT: SUB - Subscript in ^("CNT") array to increment
+2 IF $GET(SUB)=""
QUIT
+3 SET $PIECE(@DGXTMP@("CNT",SUB),U,1)=+(@DGXTMP@("CNT",SUB))+1
+4 QUIT
MISS(CAT,FLD) ; Check for missing data elements
+1 ; INPUT: CAT - MS category, 1st subscript in DGMS array
+2 ; FLD - List of fields to check for missing data
+3 ; OUTPUT: 1=Missing data; 0=No missing data
+4 NEW MISS,I,X
+5 SET MISS=0
+6 IF $GET(CAT)=""!($GET(FLD)="")
QUIT MISS
+7 FOR I=1:1
SET X=$PIECE(FLD,U,I)
IF X=""
QUIT
IF '$DATA(DGMS(CAT,X))
SET MISS=1
QUIT
+8 QUIT MISS
IMPR(CAT,FLD) ; Check for imprecise dates (year only)
+1 ; INPUT: CAT - MS category, 1st subscript in DGMS array
+2 ; FLD - List of fields to check for imprecise dates
+3 ; OUTPUT: 1=Imprecise date; 0=No imprecise date
+4 NEW IMPR,I,X
+5 SET IMPR=0
+6 IF $GET(CAT)=""!($GET(FLD)="")
QUIT IMPR
+7 FOR I=1:1
SET X=$PIECE(FLD,U,I)
IF X=""
QUIT
IF $DATA(DGMS(CAT,X))
IF '$$MNTHYR^DGRPDT(DGMS(CAT,X))
SET IMPR=1
QUIT
+8 QUIT IMPR
OVRLP(CAT) ; Check if MSE dates overlap with another MSE
+1 ; INPUT: CAT - MS category, 1st subscript in DGMS array
+2 ; OUTPUT: 0=No overlap; 1^X=Overlap^MSE that overlaps
+3 NEW OVR,MSE,DGI,DGX
+4 SET OVR=0
+5 IF $GET(CAT)=""
QUIT OVR
+6 SET DGX=$EXTRACT(CAT,4)
+7 ; If MSE1, no check; if MSE2, check overlap with MSE1; if MSE3, check
+8 ; overlap with MSE2 or MSE1
+9 FOR DGI=(DGX-1):-1:1
SET MSE="MSE"_DGI
IF $DATA(DGMS(MSE))
Begin DoDot:1
+10 SET OVR=$$WITHIN^DGRPDT($GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),$GET(DGMS(MSE,"FDT")))
IF OVR
SET OVR=+OVR_U_MSE
QUIT
+11 SET OVR=$$WITHIN^DGRPDT($GET(DGMS(CAT,"FDT")),$GET(DGMS(CAT,"TDT")),$GET(DGMS(MSE,"TDT")))
IF OVR
SET OVR=+OVR_U_MSE
QUIT
End DoDot:1
IF OVR
QUIT
+12 QUIT OVR
LOC(LN) ; Return conflict location abbreviation to pass to $$CNFLCTDT^DGRPDT
+1 ; INPUT: LN - POW Location file #22 IEN
+2 ; OUTPUT: Conflict location abbreviation
+3 IF '$GET(LN)
QUIT ""
+4 SET LN=$PIECE($GET(^DIC(22,LN,0)),U,1)
IF LN=""
QUIT ""
+5 IF LN="WORLD WAR I"
QUIT "WWI"
+6 IF LN["EUROPE"
QUIT "WWIIE"
+7 IF LN["PACIFIC"
QUIT "WWIIP"
+8 IF LN["KOREA"
QUIT "KOR"
+9 IF LN["VIETNAM"
QUIT "VIET"
+10 IF LN="OTHER"
QUIT ""
+11 IF LN["GULF"
QUIT "GULF"
+12 IF LN["YUGOSLAVIA"
QUIT "YUG"
+13 QUIT ""
