- DGNOZMH ;ALB/CLT,DJS - NO ZMH SEGMENT IN Z11 HL7 MESSAGE AND CLEAN UP INCOMPLETE MILITARY SERVICE EPISODES ;17 Mar 2018 12:09pm
- ;;5.3;REGISTRATION;**935,959**;AUG 13, 1993;Build 7
- ;
- ;The primary purpose of this routine is to delete all HEC issued military service episodes (MSE).
- ;Also used to delete any incomplete MSEs (no Discharge Date and no Future Discharge Date).
- ;
- EN(DFN) ;Primary entry point
- Q:$G(^DPT(DFN,.3216,0))="^2.3216D"
- N DGMSE,DGMSEDT,DGMSEREC,DGDFLG,DIK,DA
- S DGMSEDT=""
- F S DGMSEDT=$O(^DPT(DFN,.3216,"B",DGMSEDT),-1) Q:DGMSEDT="" D
- . S DGMSE="",DGMSE=$O(^DPT(DFN,.3216,"B",DGMSEDT,DGMSE))
- . S DGMSEREC=^DPT(DFN,.3216,DGMSE,0)
- . S DGDFLG=0
- . I $P(DGMSEREC,U,7)=1 S DGDFLG=1 ;if data is locked by HEC
- . E D
- . . Q:$P(DGMSEREC,U,2)'="" ;quit if Service Separation Date not null
- . . Q:$P(DGMSEREC,U,8)'="" ;quit if Future Discharge Date not null
- . . S DGDFLG=1 Q
- . I +DGDFLG S DA=DGMSE,DA(1)=DFN,DIK="^DPT("_DA(1)_","_.3216_"," D ^DIK
- Q
- ;
- ID1(DFN,DA,DGNEW) ;DELETE AN MSE IF INCOMPLETE
- Q:$G(DGNEW)=1
- G:$G(DA)="" IDQ
- Q:$L($P($G(^DPT(DFN,.3216,DA,0)),U,2))>4
- Q:$P(^DPT(DFN,.3216,DA,0),U,8)'=""
- S DA(1)=DFN,DIK="^DPT("_DA(1)_","_.3216_"," D ^DIK K DIK
- IDQ ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGNOZMH 1233 printed Feb 19, 2025@00:12:10 Page 2
- DGNOZMH ;ALB/CLT,DJS - NO ZMH SEGMENT IN Z11 HL7 MESSAGE AND CLEAN UP INCOMPLETE MILITARY SERVICE EPISODES ;17 Mar 2018 12:09pm
- +1 ;;5.3;REGISTRATION;**935,959**;AUG 13, 1993;Build 7
- +2 ;
- +3 ;The primary purpose of this routine is to delete all HEC issued military service episodes (MSE).
- +4 ;Also used to delete any incomplete MSEs (no Discharge Date and no Future Discharge Date).
- +5 ;
- EN(DFN) ;Primary entry point
- +1 if $GET(^DPT(DFN,.3216,0))="^2.3216D"
- QUIT
- +2 NEW DGMSE,DGMSEDT,DGMSEREC,DGDFLG,DIK,DA
- +3 SET DGMSEDT=""
- +4 FOR
- SET DGMSEDT=$ORDER(^DPT(DFN,.3216,"B",DGMSEDT),-1)
- if DGMSEDT=""
- QUIT
- Begin DoDot:1
- +5 SET DGMSE=""
- SET DGMSE=$ORDER(^DPT(DFN,.3216,"B",DGMSEDT,DGMSE))
- +6 SET DGMSEREC=^DPT(DFN,.3216,DGMSE,0)
- +7 SET DGDFLG=0
- +8 ;if data is locked by HEC
- IF $PIECE(DGMSEREC,U,7)=1
- SET DGDFLG=1
- +9 IF '$TEST
- Begin DoDot:2
- +10 ;quit if Service Separation Date not null
- if $PIECE(DGMSEREC,U,2)'=""
- QUIT
- +11 ;quit if Future Discharge Date not null
- if $PIECE(DGMSEREC,U,8)'=""
- QUIT
- +12 SET DGDFLG=1
- QUIT
- End DoDot:2
- +13 IF +DGDFLG
- SET DA=DGMSE
- SET DA(1)=DFN
- SET DIK="^DPT("_DA(1)_","_.3216_","
- DO ^DIK
- End DoDot:1
- +14 QUIT
- +15 ;
- ID1(DFN,DA,DGNEW) ;DELETE AN MSE IF INCOMPLETE
- +1 if $GET(DGNEW)=1
- QUIT
- +2 if $GET(DA)=""
- GOTO IDQ
- +3 if $LENGTH($PIECE($GET(^DPT(DFN,.3216,DA,0)),U,2))>4
- QUIT
- +4 if $PIECE(^DPT(DFN,.3216,DA,0),U,8)'=""
- QUIT
- +5 SET DA(1)=DFN
- SET DIK="^DPT("_DA(1)_","_.3216_","
- DO ^DIK
- KILL DIK
- IDQ ;
- +1 QUIT