DGMSE ;QLB/PJH,AJB Utilities (continued); 02/01/2012
;;5.3;Registration;**797**;08/13/93;Build 24
Q
;
;DBIA -5354
;
;API for clinical reminders to get military service information.
;
;
MSDATA(DFN,NEPS,ENTRYDTA,MSDATA) ;
;Return data for all military service episodes.
;Service Entry Dates are required fields.
;Gets new ESR data if present from multiple node (.3216)
N DA,DGX,ENTRYDT,NODE,SEPDT
S NEPS=0,ENTRYDT=""
F S ENTRYDT=$O(^DPT(DFN,.3216,"B",ENTRYDT)) Q:ENTRYDT="" D
. S DA=0
. F S DA=$O(^DPT(DFN,.3216,"B",ENTRYDT,DA)) Q:DA="" D
.. S NEPS=NEPS+1
.. S NODE=$G(^DPT(DFN,.3216,DA,0))
.. S ENTRYDT=$P(NODE,U,1),SEPDT=$P(NODE,U,2)
.. S ENTRYDTA(ENTRYDT)=NEPS
.. S MSDATA(NEPS,"DATE")=$S(SEPDT="":ENTRYDT,1:SEPDT)
.. S MSDATA(NEPS,"ENTRY DATE")=ENTRYDT
.. S MSDATA(NEPS,"SEPARATION DATE")=SEPDT
.. S MSDATA(NEPS,"BRANCH")=$$EXTERNAL^DILFD(2,.325,"",$P(NODE,U,3))
.. S MSDATA(NEPS,"SERVICE COMPONENT")=$$EXTERNAL^DILFD(2,.32911,"",$P(NODE,U,4))
.. S MSDATA(NEPS,"DISCHARGE TYPE")=$$EXTERNAL^DILFD(2,.324,"",$P(NODE,U,6))
I NEPS>0 Q
;Gets data from non-multiple node (.32) only if data does not exist
;in the multiple.
I '$D(^DPT(DFN,.32)) Q
S NODE=$G(^DPT(DFN,.32)),NODE("SC")=$G(^DPT(DFN,.3291))
F DGX=7,12,17 D
. S ENTRYDT=$P(NODE,U,(DGX-1))
. I ENTRYDT="" Q
. S NEPS=NEPS+1
. S ENTRYDTA(ENTRYDT)=NEPS
. S SEPDT=$P(NODE,U,DGX)
. S MSDATA(NEPS,"DATE")=$S(SEPDT="":ENTRYDT,1:SEPDT)
. S MSDATA(NEPS,"ENTRY DATE")=ENTRYDT
. S MSDATA(NEPS,"SEPARATION DATE")=SEPDT
. S MSDATA(NEPS,"BRANCH")=$$EXTERNAL^DILFD(2,.325,"",$P(NODE,U,(DGX-2)))
. S MSDATA(NEPS,"SERVICE COMPONENT")=$$EXTERNAL^DILFD(2,.32911,"",$P(NODE("SC"),U,$S(DGX=7:1,DGX=12:2,DGX=17:3)))
. S MSDATA(NEPS,"DISCHARGE TYPE")=$$EXTERNAL^DILFD(2,.324,"",$P(NODE,U,(DGX-3)))
Q
;
;
OEIF(BDT,EDT,LSUB) ;Return a list of patient with OEF/OIF/UNK service in the
;date range specified by BDT to EDT.
N DA,DFN,FDATE,SLOC,TDATE
K ^TMP($J,LSUB)
S TDATE=BDT-.1
F S TDATE=$O(^DPT("ALOEIF",TDATE)) Q:TDATE="" D
. S FDATE=0
. F S FDATE=$O(^DPT("ALOEIF",TDATE,FDATE)) Q:(FDATE>EDT)!(FDATE="") D
.. S SLOC=""
.. F S SLOC=$O(^DPT("ALOEIF",TDATE,FDATE,SLOC)) Q:SLOC="" D
... S DFN=""
... F S DFN=$O(^DPT("ALOEIF",TDATE,FDATE,SLOC,DFN)) Q:DFN="" D
.... S DA=""
.... F S DA=$O(^DPT("ALOEIF",TDATE,FDATE,SLOC,DFN,DA)) Q:DA="" D
..... S ^TMP($J,LSUB,DFN,FDATE,TDATE,SLOC,DA)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSE 2454 printed Dec 13, 2024@02:44:18 Page 2
DGMSE ;QLB/PJH,AJB Utilities (continued); 02/01/2012
+1 ;;5.3;Registration;**797**;08/13/93;Build 24
+2 QUIT
+3 ;
+4 ;DBIA -5354
+5 ;
+6 ;API for clinical reminders to get military service information.
+7 ;
+8 ;
MSDATA(DFN,NEPS,ENTRYDTA,MSDATA) ;
+1 ;Return data for all military service episodes.
+2 ;Service Entry Dates are required fields.
+3 ;Gets new ESR data if present from multiple node (.3216)
+4 NEW DA,DGX,ENTRYDT,NODE,SEPDT
+5 SET NEPS=0
SET ENTRYDT=""
+6 FOR
SET ENTRYDT=$ORDER(^DPT(DFN,.3216,"B",ENTRYDT))
if ENTRYDT=""
QUIT
Begin DoDot:1
+7 SET DA=0
+8 FOR
SET DA=$ORDER(^DPT(DFN,.3216,"B",ENTRYDT,DA))
if DA=""
QUIT
Begin DoDot:2
+9 SET NEPS=NEPS+1
+10 SET NODE=$GET(^DPT(DFN,.3216,DA,0))
+11 SET ENTRYDT=$PIECE(NODE,U,1)
SET SEPDT=$PIECE(NODE,U,2)
+12 SET ENTRYDTA(ENTRYDT)=NEPS
+13 SET MSDATA(NEPS,"DATE")=$SELECT(SEPDT="":ENTRYDT,1:SEPDT)
+14 SET MSDATA(NEPS,"ENTRY DATE")=ENTRYDT
+15 SET MSDATA(NEPS,"SEPARATION DATE")=SEPDT
+16 SET MSDATA(NEPS,"BRANCH")=$$EXTERNAL^DILFD(2,.325,"",$PIECE(NODE,U,3))
+17 SET MSDATA(NEPS,"SERVICE COMPONENT")=$$EXTERNAL^DILFD(2,.32911,"",$PIECE(NODE,U,4))
+18 SET MSDATA(NEPS,"DISCHARGE TYPE")=$$EXTERNAL^DILFD(2,.324,"",$PIECE(NODE,U,6))
End DoDot:2
End DoDot:1
+19 IF NEPS>0
QUIT
+20 ;Gets data from non-multiple node (.32) only if data does not exist
+21 ;in the multiple.
+22 IF '$DATA(^DPT(DFN,.32))
QUIT
+23 SET NODE=$GET(^DPT(DFN,.32))
SET NODE("SC")=$GET(^DPT(DFN,.3291))
+24 FOR DGX=7,12,17
Begin DoDot:1
+25 SET ENTRYDT=$PIECE(NODE,U,(DGX-1))
+26 IF ENTRYDT=""
QUIT
+27 SET NEPS=NEPS+1
+28 SET ENTRYDTA(ENTRYDT)=NEPS
+29 SET SEPDT=$PIECE(NODE,U,DGX)
+30 SET MSDATA(NEPS,"DATE")=$SELECT(SEPDT="":ENTRYDT,1:SEPDT)
+31 SET MSDATA(NEPS,"ENTRY DATE")=ENTRYDT
+32 SET MSDATA(NEPS,"SEPARATION DATE")=SEPDT
+33 SET MSDATA(NEPS,"BRANCH")=$$EXTERNAL^DILFD(2,.325,"",$PIECE(NODE,U,(DGX-2)))
+34 SET MSDATA(NEPS,"SERVICE COMPONENT")=$$EXTERNAL^DILFD(2,.32911,"",$PIECE(NODE("SC"),U,$SELECT(DGX=7:1,DGX=12:2,DGX=17:3)))
+35 SET MSDATA(NEPS,"DISCHARGE TYPE")=$$EXTERNAL^DILFD(2,.324,"",$PIECE(NODE,U,(DGX-3)))
End DoDot:1
+36 QUIT
+37 ;
+38 ;
OEIF(BDT,EDT,LSUB) ;Return a list of patient with OEF/OIF/UNK service in the
+1 ;date range specified by BDT to EDT.
+2 NEW DA,DFN,FDATE,SLOC,TDATE
+3 KILL ^TMP($JOB,LSUB)
+4 SET TDATE=BDT-.1
+5 FOR
SET TDATE=$ORDER(^DPT("ALOEIF",TDATE))
if TDATE=""
QUIT
Begin DoDot:1
+6 SET FDATE=0
+7 FOR
SET FDATE=$ORDER(^DPT("ALOEIF",TDATE,FDATE))
if (FDATE>EDT)!(FDATE="")
QUIT
Begin DoDot:2
+8 SET SLOC=""
+9 FOR
SET SLOC=$ORDER(^DPT("ALOEIF",TDATE,FDATE,SLOC))
if SLOC=""
QUIT
Begin DoDot:3
+10 SET DFN=""
+11 FOR
SET DFN=$ORDER(^DPT("ALOEIF",TDATE,FDATE,SLOC,DFN))
if DFN=""
QUIT
Begin DoDot:4
+12 SET DA=""
+13 FOR
SET DA=$ORDER(^DPT("ALOEIF",TDATE,FDATE,SLOC,DFN,DA))
if DA=""
QUIT
Begin DoDot:5
+14 SET ^TMP($JOB,LSUB,DFN,FDATE,TDATE,SLOC,DA)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
