- 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 Feb 19, 2025@00:10:21 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
