| 1 | DGRPMS ;ALB/BRM,LBD - MILITARY SERVICE APIS ; 1/24/05 8:44am
|
|---|
| 2 | ;;5.3;Registration;**451,626,646,673,689**;Aug 13, 1993;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | VALCON1(DFN,IEN,CDATE,FRTO) ; Valid conflict input for OIF/OEF/UNKNOWN OEF/OIF?
|
|---|
| 5 | ; Need to send the ien of the multiple as well as the DFN and
|
|---|
| 6 | ; determine the specific conflict area
|
|---|
| 7 | N Z
|
|---|
| 8 | S Z=$P("OIF^OEF^UNK",U,+$G(^DPT(DFN,.3215,+IEN,0)))
|
|---|
| 9 | ;Q:Z="UNK" 1 ; Never need to check this - only entered through HEC
|
|---|
| 10 | Q $$VALCON(DFN,Z_"-"_IEN,CDATE,FRTO)
|
|---|
| 11 | ;
|
|---|
| 12 | VALCON(DFN,CNFLCT,CDATE,FRTO,OEIFAIL) ;is this a valid conflict input?
|
|---|
| 13 | ;
|
|---|
| 14 | ;INPUT:
|
|---|
| 15 | ; FRTO - 0=FRDT 1=TODT (defaults to FRDT if FRTO="")
|
|---|
| 16 | ;OUTPUT:
|
|---|
| 17 | ; OEIFAIL = 1 for not within MSE for OIF/OEF data (pass by ref)
|
|---|
| 18 | ;
|
|---|
| 19 | N RTN,X,Y,FRDT,TODT,CNFLCTV,IGNORE,COMPOW,MSG,DTCHK,CNFLCT2,OEFOIF
|
|---|
| 20 | S OEIFAIL=0
|
|---|
| 21 | Q:'$D(DFN) "0^INVALID PATIENT"
|
|---|
| 22 | Q:'$D(^DPT(DFN)) "0^INVALID PATIENT"
|
|---|
| 23 | Q:'$$VALID^DGRPDT(.CDATE) "0^INVALID DATE"
|
|---|
| 24 | S FRTO=+$G(FRTO)
|
|---|
| 25 | I 'FRTO S TODT=$$GETDT(DFN,.CNFLCT),FRDT=CDATE K DGFRDT
|
|---|
| 26 | E S FRDT=$$GETDT(DFN,.CNFLCT,FRTO) S:$G(DGFRDT) FRDT=$G(DGFRDT) S TODT=CDATE K DGFRDT
|
|---|
| 27 | S DTCHK=$$DTUTIL^DGRPDT(CDATE,$$GETDT(DFN,.CNFLCT,'FRTO),1)
|
|---|
| 28 | I 'DTCHK D MSG($P(DTCHK,"^",2),2,2) Q DTCHK
|
|---|
| 29 | I CNFLCT="COMB"!(CNFLCT="POW") D
|
|---|
| 30 | .S COMPOW=$S(CNFLCT="COMB":1,1:2)
|
|---|
| 31 | .S CNFLCT2=CNFLCT
|
|---|
| 32 | .S CNFLCT=$$COMPOW($S($G(DGCOMLOC):$P(DGCOMLOC,"^"),1:$$GETDT(DFN,CNFLCT,3)))
|
|---|
| 33 | S CNFLCTV=""
|
|---|
| 34 | I CNFLCT]"" S CNFLCTV=$$CNFLCTDT^DGRPDT(FRDT,$S(FRTO:TODT,1:""),.CNFLCT)
|
|---|
| 35 | I ('CNFLCTV) D MSG($P(CNFLCTV,"^",2),2,1) Q CNFLCTV ;dates are not within conflict
|
|---|
| 36 | ;
|
|---|
| 37 | S MSG=$S('$G(COMPOW):"Conflict",$G(COMPOW)=2:"POW",1:"Combat")
|
|---|
| 38 | I FRDT,TODT,'$$B4^DGRPDT(FRDT,TODT,0) D MSG((MSG_" From Date is not Before "_MSG_" To Date"),2,1) Q "0^"_MSG_" From Date is not Before "_MSG_" To Date"
|
|---|
| 39 | S IGNORE=$S('$P(CNFLCT,"-",2):$P($P($T(@($P(CNFLCT,"-"))),";;",2),"^",FRTO+1),1:"")
|
|---|
| 40 | S:$G(COMPOW) IGNORE=$P($P($T(@(CNFLCT2)),";;",2),"^",FRTO+1)
|
|---|
| 41 | I $G(COMPOW)=2 D
|
|---|
| 42 | . S RTN=$$OVRLPCHK^DGRPDT(DFN,FRDT,TODT,-1,IGNORE)
|
|---|
| 43 | E D
|
|---|
| 44 | . S OEFOIF=$S($P(CNFLCT,"-",2):$P(CNFLCT,"-",2)_U_CNFLCT,1:""),RTN=$$COVRLP2^DGRPDT(DFN,FRDT,TODT,IGNORE,.OEFOIF)
|
|---|
| 45 | . I 'RTN,$G(OEFOIF),$G(OEFOIF(1)) S OEIFAIL=1
|
|---|
| 46 | Q:RTN RTN
|
|---|
| 47 | D MSG($P(RTN,"^",2),2,1)
|
|---|
| 48 | Q RTN
|
|---|
| 49 | ;
|
|---|
| 50 | VALMSE(DFN,MDATE,FRTO,FLD) ;is this a valid Military Service Episode date?
|
|---|
| 51 | ;
|
|---|
| 52 | ;INPUT:
|
|---|
| 53 | ; FRTO - 0=FRDT 1=TODT (defaults to FRDT if FRTO="")
|
|---|
| 54 | ; FLD - MSE field being edited/added (MSL,MSNTL,MSNNTL)
|
|---|
| 55 | ;
|
|---|
| 56 | N RTN,X,Y,FRDT,TODT,IGNORE,DTCHK
|
|---|
| 57 | Q:'$D(DFN) "0^INVALID PATIENT"
|
|---|
| 58 | Q:'$D(^DPT(DFN)) "0^INVALID PATIENT"
|
|---|
| 59 | Q:'$$VALID^DGRPDT(.MDATE) "0^INVALID DATE"
|
|---|
| 60 | S FRTO=+$G(FRTO)
|
|---|
| 61 | I 'FRTO S FRDT=MDATE,TODT=$$GETDT(DFN,.FLD,FRTO) K DGFRDT
|
|---|
| 62 | E S FRDT=$$GETDT(DFN,.FLD,FRTO) S:$G(DGFRDT) FRDT=$G(DGFRDT) S TODT=MDATE K DGFRDT
|
|---|
| 63 | S DTCHK=$$DTUTIL^DGRPDT(MDATE,$$GETDT(DFN,.FLD,'FRTO),1)
|
|---|
| 64 | I 'DTCHK D MSG($P(DTCHK,"^",2),2,2) K DGCOMBR Q DTCHK
|
|---|
| 65 | I FRTO,FRDT,TODT,'$$B4^DGRPDT(.FRDT,.TODT,0) D MSG("Service Entry Date is not before Service Separation Date",2,1) K DGCOMBR Q "0^Service Entry Date is not before Service Separation Date"
|
|---|
| 66 | S IGNORE=$P($P($T(@(FLD)),";;",2),"^",FRTO+1)
|
|---|
| 67 | S RTN=$$OVRLPCHK^DGRPDT(.DFN,.FRDT,.TODT,1,.IGNORE)
|
|---|
| 68 | I $G(DGCOMBR)']"" S DGCOMBR=$$GETDT(DFN,.FLD,4)
|
|---|
| 69 | I RTN,FRTO,$$BRANCH(.DGCOMBR),('$$WWII(DFN,TODT,.FLD)) D MSG("Branch of Service Requires WWII Dates of Service",2,1) K DGCOMBR Q "0^BOS Requires WWII Dates"
|
|---|
| 70 | K DGCOMBR
|
|---|
| 71 | Q:RTN RTN
|
|---|
| 72 | D MSG($P(RTN,"^",2),2,1)
|
|---|
| 73 | Q RTN
|
|---|
| 74 | ;
|
|---|
| 75 | BRANCH(DGCOMBR) ;branches of service that require WWII service dates
|
|---|
| 76 | N BRANCH
|
|---|
| 77 | Q:'$G(DGCOMBR) 0
|
|---|
| 78 | S BRANCH=$P(DGCOMBR,"^",2)
|
|---|
| 79 | Q:BRANCH="MERCHANT SEAMAN" 1
|
|---|
| 80 | Q:BRANCH="F.COMMONWEALTH" 1
|
|---|
| 81 | Q:BRANCH="F.GUERILLA" 1
|
|---|
| 82 | Q:BRANCH="F.SCOUTS NEW" 1
|
|---|
| 83 | Q:BRANCH="F.SCOUTS OLD" 1
|
|---|
| 84 | Q 0
|
|---|
| 85 | ;
|
|---|
| 86 | VALCOMP(DFN,CODE,DGEPI) ; Verify component is consistent with the corresponding
|
|---|
| 87 | ; branch of service Also, branch of service must be entered before
|
|---|
| 88 | ; component.
|
|---|
| 89 | ; ACTIVATED NATIONAL GUARD (G) only valid for ARMY or AIR FORCE branch
|
|---|
| 90 | ; ACTIVATED RESERVE (V) only valid for ARMY, AIR FORCE, MARINES, NAVY
|
|---|
| 91 | ; or COAST GUARD branch
|
|---|
| 92 | ; DFN = ien of patient in file 2
|
|---|
| 93 | ; DGEPI = episode # to check (1=LAST, 2=NTL, 3=NNTL)
|
|---|
| 94 | ; CODE = the component code
|
|---|
| 95 | ; OUTPUT: 1 if valid component
|
|---|
| 96 | ; 0 if invalid component or branch of serv missing
|
|---|
| 97 | N Z
|
|---|
| 98 | S Z=+$P($G(^DPT(DFN,.32)),U,DGEPI*5)
|
|---|
| 99 | I 'Z Q 0 ; Require bos
|
|---|
| 100 | I CODE="R" Q 1 ; Regular is valid for all
|
|---|
| 101 | Q:Z=1!(Z=2) 1 ; Army (1)/air force (2) valid for guard and reserves
|
|---|
| 102 | ; reserves also include navy (3), marines (4), coast guard (5)
|
|---|
| 103 | I CODE="V" Q $S(Z>2&(Z<6):1,1:0)
|
|---|
| 104 | ;
|
|---|
| 105 | Q 0
|
|---|
| 106 | ;
|
|---|
| 107 | GETDT(DFN,CNFLCT,FRTO) ; get from date, to date, or location from patient file
|
|---|
| 108 | ;
|
|---|
| 109 | N CFLDS,CFLD,CNF1,CNF2,RTN1,IENS,FILE
|
|---|
| 110 | Q:'$D(DFN) ""
|
|---|
| 111 | Q:'$D(^DPT(DFN)) ""
|
|---|
| 112 | Q:$G(CNFLCT)="" ""
|
|---|
| 113 | S:$G(FRTO)="" FRTO=0
|
|---|
| 114 | S CNF1=$P(CNFLCT,"-"),CNF2=+$P(CNFLCT,"-",2)
|
|---|
| 115 | ; OEF/OIF/ UNKNOWN OEF/OIF data without a supplied entry in the
|
|---|
| 116 | ; multiple cannot be retrieved OEF-1 indicates an OEF location
|
|---|
| 117 | ; stored at the '1' subscript of the .3215 multiple
|
|---|
| 118 | I "^OEF^OIF^UNK^"[(U_CNF1_U),'CNF2 Q ""
|
|---|
| 119 | S CFLDS=$P($T(@(CNF1)),";;",2) Q:CFLDS']"" ""
|
|---|
| 120 | S CFLD=$S('FRTO:$P(CFLDS,"^",2),FRTO=1:$P(CFLDS,"^"),1:$P(CFLDS,"^",3))
|
|---|
| 121 | Q:'CFLD ""
|
|---|
| 122 | S IENS=DFN_",",FILE=2
|
|---|
| 123 | S:CNF2 IENS=CNF2_","_IENS,FILE=2.3215 ; For OIF/OEF, must set ref to multiple
|
|---|
| 124 | S RTN1=$$GET1^DIQ(FILE,IENS,CFLD,"I")
|
|---|
| 125 | I FRTO=4 S RTN1=RTN1_"^"_$$EXTERNAL^DILFD(FILE,CFLD,"",RTN1)
|
|---|
| 126 | Q RTN1
|
|---|
| 127 | ;
|
|---|
| 128 | WWII(DFN,TODT,FLD) ; was this patient in WWII?
|
|---|
| 129 | ; this API assumes the WWII period to be from 12/07/41-12/31/46
|
|---|
| 130 | ;
|
|---|
| 131 | N OK,NODE,DATA,WWIIS,WWIIE,PATDT,PATE,PATS
|
|---|
| 132 | Q:'$G(DFN) "-1^UNKNOWN"
|
|---|
| 133 | S NODE(.32)=".326,.327,.3285,.3292,.3293,.32945,.3297,.3298"
|
|---|
| 134 | S WWIIS=2411207,WWIIE=2461231
|
|---|
| 135 | D GETDAT^DGRPDT(DFN,.NODE,.DATA)
|
|---|
| 136 | S PATDT=$G(FLD) Q:PATDT']"" 0
|
|---|
| 137 | S PATS=$P($G(DATA(PATDT)),"^"),PATE=$P($G(DATA(PATDT)),"^",2)
|
|---|
| 138 | S:'$G(TODT) TODT=PATE
|
|---|
| 139 | S OK=0
|
|---|
| 140 | S OK=$$WITHIN^DGRPDT(WWIIS,WWIIE,PATS)
|
|---|
| 141 | S:'OK OK=$$WITHIN^DGRPDT(WWIIS,WWIIE,TODT)
|
|---|
| 142 | S:'OK OK=$$RWITHIN^DGRPDT(PATS,TODT,WWIIS,WWIIE)
|
|---|
| 143 | Q $G(OK)
|
|---|
| 144 | DELMSE(DFN,TYPE) ; delete MSE from patient
|
|---|
| 145 | ;
|
|---|
| 146 | ; Input: DFN - Internal entry number for the Patient File (#2)
|
|---|
| 147 | ; TYPE - 1=Last MSE 2=Next to Last MSE 3=Next to Next to Last
|
|---|
| 148 | ;
|
|---|
| 149 | Q:'$G(TYPE)
|
|---|
| 150 | Q:(('$G(DFN))!'$D(^DPT(DFN)))
|
|---|
| 151 | N IENS,FDA,X,X1,X2,Y,ZZ,ROOT
|
|---|
| 152 | S IENS=DFN_",",ROOT="FDA(2,IENS)",X=""
|
|---|
| 153 | I TYPE=1 F ZZ=.324,.326,.327,.328 S @ROOT@(ZZ)=X
|
|---|
| 154 | I TYPE=2 F ZZ=.329,.3292,.3293,.3294 S @ROOT@(ZZ)=X
|
|---|
| 155 | I TYPE=3 F ZZ=.3295,.3297,.3298,.3299 S @ROOT@(ZZ)=X
|
|---|
| 156 | D FILE^DIE("K","FDA","ERR")
|
|---|
| 157 | Q
|
|---|
| 158 | ;
|
|---|
| 159 | COMPOW(VAL) ;convert POW and Combat Location fields
|
|---|
| 160 | ;
|
|---|
| 161 | N ABRV
|
|---|
| 162 | Q:'$G(VAL) ""
|
|---|
| 163 | S ABRV=$$GET1^DIQ(22,VAL_",",1,"I")
|
|---|
| 164 | Q:ABRV="WWI" "WWI"
|
|---|
| 165 | Q:ABRV="WWII-EUROPE" "WWIIE"
|
|---|
| 166 | Q:ABRV="WWII-PACIFIC" "WWIIP"
|
|---|
| 167 | Q:ABRV="KOREAN" "KOR"
|
|---|
| 168 | Q:ABRV="VIETNAM" "VIET"
|
|---|
| 169 | Q:ABRV="OTHER" "OTHER"
|
|---|
| 170 | Q:ABRV="PERSIAN GULF" "GULF"
|
|---|
| 171 | Q:ABRV="YUGOSLAVIA" "YUG"
|
|---|
| 172 | Q:ABRV="SOMALIA" "SOM"
|
|---|
| 173 | Q ""
|
|---|
| 174 | ;
|
|---|
| 175 | FV(X) ;Is this a Filipino Vet branch of service?
|
|---|
| 176 | ;Added for HVE II (DG*5.3*451)
|
|---|
| 177 | ;INPUT: X = IEN Branch of Service file #23
|
|---|
| 178 | ;OUTPUT: 1 = Filipino Vet BOS (F.COMMONWEALTH, F.GUERILLA, F.SCOUTS NEW)
|
|---|
| 179 | ; 2 = Filipino Vet BOS (F.SCOUTS OLD)
|
|---|
| 180 | ; 0 = Not Filipino Vet BOS
|
|---|
| 181 | N FV
|
|---|
| 182 | I '$G(X) Q 0
|
|---|
| 183 | S FV=$P($G(^DIC(23,X,0)),U,1)
|
|---|
| 184 | Q $S(FV="F.SCOUTS OLD":2,$E(FV,1,2)="F.":1,1:0)
|
|---|
| 185 | ;
|
|---|
| 186 | FVP ;MUMPS cross-reference "AFV1" on Service Branch [Last] (#.325), "AFV2"
|
|---|
| 187 | ;on Service Branch [NTL] (#.3291), and "AFV3" on Service Branch [NNTL]
|
|---|
| 188 | ;(#.3296) in the Patient file #2. If the Service Branch fields do not
|
|---|
| 189 | ;contain a Filipino Veteran branch of service, the Filipino Vet Proof
|
|---|
| 190 | ;field (#.3214) will be deleted.
|
|---|
| 191 | Q:'$G(DA)
|
|---|
| 192 | N BOS,MS,FV,IENS,FDA
|
|---|
| 193 | S MS=$G(^DPT(DA,.32))
|
|---|
| 194 | F BOS=5,10,15 S FV=$$FV($P(MS,U,BOS)) Q:FV=1
|
|---|
| 195 | I FV=1 Q ;Filipino Vet BOS found, quit
|
|---|
| 196 | ;Delete Filipino Vet Proof
|
|---|
| 197 | S IENS=DA_",",FDA(2,IENS,.3214)="@"
|
|---|
| 198 | D FILE^DIE("","FDA")
|
|---|
| 199 | Q
|
|---|
| 200 | ;
|
|---|
| 201 | MSG(MSGTXT,LF1,LF2) ; This api will format the output text in order to utilize
|
|---|
| 202 | ; the EN^DDIOL utility.
|
|---|
| 203 | ;INPUT: MSGTXT = Message text to display
|
|---|
| 204 | ; LF1 = Number of line feeds to preceed the message
|
|---|
| 205 | ; L2F = Number of line feeds to follow the message
|
|---|
| 206 | ;
|
|---|
| 207 | N MSGARY,LFSTR
|
|---|
| 208 | S $P(LFSTR,"!",50)="!"
|
|---|
| 209 | S:$G(LF1)'="" MSGARY(.5,"F")=$E(LFSTR,1,(LF1-1))
|
|---|
| 210 | S MSGARY(1)=MSGTXT
|
|---|
| 211 | S:$G(LF2)'="" MSGARY(2,"F")=$E(LFSTR,1,LF2)
|
|---|
| 212 | D EN^DDIOL(.MSGARY)
|
|---|
| 213 | Q
|
|---|
| 214 | ;
|
|---|
| 215 | CNFLCT ;; *** DO NOT REMOVE BELOW CONFLICT FIELD LOCATIONS ***
|
|---|
| 216 | ;; FROM DATE^TO DATE
|
|---|
| 217 | WWI ;;
|
|---|
| 218 | WWIIE ;;
|
|---|
| 219 | WWIIP ;;
|
|---|
| 220 | KOR ;;
|
|---|
| 221 | VIET ;;.32104^.32105
|
|---|
| 222 | LEB ;;.3222^.3223
|
|---|
| 223 | GREN ;;.3225^.3226
|
|---|
| 224 | PAN ;;.3228^.3229
|
|---|
| 225 | GULF ;;.322011^.322012
|
|---|
| 226 | SOM ;;.322017^.322018
|
|---|
| 227 | YUG ;;.32202^.322021
|
|---|
| 228 | OEF ;;.02^.03
|
|---|
| 229 | OIF ;;.02^.03
|
|---|
| 230 | UNK ;;.02^.03
|
|---|
| 231 | ;;
|
|---|
| 232 | ;; **BELOW VALUES ARE USED FOR MSE CHECKS - DO NOT REMOVE ***
|
|---|
| 233 | ;; ENTRY DATE^SEPERATION DATE
|
|---|
| 234 | MSL ;;.326^.327^.325
|
|---|
| 235 | MSNTL ;;.3292^.3293^.3291
|
|---|
| 236 | MSNNTL ;;.3297^.3298^.3296
|
|---|
| 237 | ;;
|
|---|
| 238 | ;; **BELOW VALUES ARE USED FOR POW AND COMBAT CHECKS - DO NOT REMOVE
|
|---|
| 239 | ;; FROM DATE^TO DATE^LOCATION
|
|---|
| 240 | COMB ;;.5293^.5294^.5292
|
|---|
| 241 | POW ;;.527^.528^.526
|
|---|
| 242 | ;;
|
|---|
