Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGNOZMH

DGNOZMH.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;The primary purpose of this routine is to delete all HEC issued military service episodes (MSE).
  1. ;Also used to delete any incomplete MSEs (no Discharge Date and no Future Discharge Date).
  1. ;
  1. EN(DFN) ;Primary entry point
  1. Q:$G(^DPT(DFN,.3216,0))="^2.3216D"
  1. N DGMSE,DGMSEDT,DGMSEREC,DGDFLG,DIK,DA
  1. S DGMSEDT=""
  1. F S DGMSEDT=$O(^DPT(DFN,.3216,"B",DGMSEDT),-1) Q:DGMSEDT="" D
  1. . S DGMSE="",DGMSE=$O(^DPT(DFN,.3216,"B",DGMSEDT,DGMSE))
  1. . S DGMSEREC=^DPT(DFN,.3216,DGMSE,0)
  1. . S DGDFLG=0
  1. . I $P(DGMSEREC,U,7)=1 S DGDFLG=1 ;if data is locked by HEC
  1. . E D
  1. . . Q:$P(DGMSEREC,U,2)'="" ;quit if Service Separation Date not null
  1. . . Q:$P(DGMSEREC,U,8)'="" ;quit if Future Discharge Date not null
  1. . . S DGDFLG=1 Q
  1. . I +DGDFLG S DA=DGMSE,DA(1)=DFN,DIK="^DPT("_DA(1)_","_.3216_"," D ^DIK
  1. Q
  1. ;
  1. ID1(DFN,DA,DGNEW) ;DELETE AN MSE IF INCOMPLETE
  1. Q:$G(DGNEW)=1
  1. G:$G(DA)="" IDQ
  1. Q:$L($P($G(^DPT(DFN,.3216,DA,0)),U,2))>4
  1. Q:$P(^DPT(DFN,.3216,DA,0),U,8)'=""
  1. S DA(1)=DFN,DIK="^DPT("_DA(1)_","_.3216_"," D ^DIK K DIK
  1. IDQ ;
  1. Q