DGOTHMST ;SLC/MKN - OTH PROCESSING FOLLOWING MST SCREENING ; 06/21/2019
;;5.3;Registration;**977,1016**;Aug 13, 1993;Build 6
;
;OTH processing following MST Screening
;
MSTCHNG(DA) ; DG*5.3*1016
;This API is called when MST Screening changes and, if the previous status was "Y"
;and the new status is either "N" or "D", a MailMan message is sent to the DGEN ELIGIBILITY ALERT group
;
;Input Parameter:
; DA = IEN of entry in file #29.11
;
N DGDFN,DGPREDTM,DGPREST,DGSSN,IEN2911,IENS,IENS2,PATDATA
S DGDFN=$$GET1^DIQ(29.11,DA_",",2,"I") Q:'DGDFN
I $$GET1^DIQ(29.11,DA_",",3,"I")="Y" D MSTPROC(DGDFN) Q ; current MST status is "YES"
I '$$ISOTHD^DGOTHD(DGDFN) Q ; primary eligibility is not Expanded MH Care
I $$GETEXPMH^DGOTHD(DGDFN)'="OTH-EXT" Q ; MH care type (2/.5501) is not OTH-EXT
; quit if previous MST status is not "YES"
S IEN2911=$O(^DGMS(29.11,"C",DGDFN,DA),-1) Q:'IEN2911
S IENS=IEN2911_","
S DGPREST=$$GET1^DIQ(29.11,IENS,3,"I") Q:DGPREST'="Y"
;
S DGPREDTM=$$GET1^DIQ(29.11,IENS,.01,"I") ; timestamp of the previous MST status
S IENS2=DGDFN_"," D GETS^DIQ(2,IENS2,".01;.02;.03;.09;.5502;991.01","EI","PATDATA") I '$D(PATDATA) Q
; if previous MST status change happened while primary eligibility was Expanded MH Care and last MH care type change was not automatic, quit
I '$$CHKELIG(DGDFN,DGPREDTM)&'$$CHKADTM(DGDFN,PATDATA(2,IENS2,.5502,"I")) Q
;
S DGSSN=PATDATA(2,IENS2,.09,"E")
S DGMSG(1)="Eligibility personnel should re-evaluate this Patient's"
S DGMSG(2)="Expanded MH Care Type as their MST Screening CR has been"
S DGMSG(3)="changed from positive to negative/decline."
S DGMSG(4)=" "
S DGMSG(5)="Patient Name: "_PATDATA(2,IENS2,.01,"E")
S DGMSG(6)=" "
S DGMSG(7)="SSN: "_$E(DGSSN,$L(DGSSN)-3,$L(DGSSN))
S DGMSG(8)=" "
S DGMSG(9)="DOB: "_PATDATA(2,IENS2,.03,"E")
S DGMSG(10)=" "
S DGMSG(11)="SEX: "_PATDATA(2,IENS2,.02,"E")
S DGMSG(12)=" "
S DGMSG(13)="VPID: "_PATDATA(2,IENS2,991.01,"E")
S DGMSG(14)=" "
S DGMSG(15)="DFN: "_DGDFN
S DGMSG(16)=" "
S DGMSG(17)="STATION NUMBER: "_$P($$SITE^VASITE(),U,3)
S DGMSG(18)=" "
D SENDMSG(.DGMSG,"Eligibility re-evaluation needed.")
Q
;
CHKADTM(DGDFN,AUTODTM) ; check if last MH care type change was automatic DG*5.3*1016
;
; DGDFN - patient's DFN
; AUTODTM - timestamp of automatic MH care type change (from 2/.5502)
;
; returns: 1 if last MH care type change was automatic,
; 0 if last MH care type change was not automatic,
; -1 if error was encountered
;
N IEN33,LASTDTM
I +DGDFN'>0 Q -1 ; invalid DFN
S IEN33=$O(^DGOTH(33,"B",DGDFN,"")) I 'IEN33 Q -1 ; no entry in file 33
I 'AUTODTM Q 0 ; no automatic change timestamp
S LASTDTM=+$O(^DGOTH(33,IEN33,2,"B",""),-1) ; timestamp of last eligibility change from sub-file 33.02
I $$FMDIFF^XLFDT(LASTDTM,AUTODTM,2)'=0 Q 0 ; timestamps don't match
Q 1
;
CHKELIG(DGDFN,MSTDTM) ; check if given MST status change happened while primary eligibility was not Expanded MH Care DG*5.3*1016
;
; DGDFN - patient's DFN
; MSTDTM - timestamp of the MST status change (from 29.11/.01)
;
; returns: 1 if MST status change happened while primary eligibility was not Expanded MH Care,
; 0 if MST status change happened while primary eligibility was Expanded MH Care,
; -1 if error was encountered
;
N DGDTM,IEN33,IEN3302
I +DGDFN'>0 Q -1 ; invalid DFN
I +MSTDTM'>0 Q -1 ; invalid MST timestamp
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I 'IEN33 Q -1 ; no entry in file 33
S DGDTM=+$O(^DGOTH(33,IEN33,2,"B",MSTDTM),-1) I 'DGDTM Q 1 ; no prior eligibility change in file 33 = patient was not OTH
S IEN3302=+$O(^DGOTH(33,IEN33,2,"B",DGDTM,"")) I 'IEN3302 Q 1
I $$GET1^DIQ(33.02,IEN3302_","_IEN33_",",.02)'="EXPANDED MH CARE NON-ENROLLEE" Q 1 ; prior eligibility change was not OTH
Q 0
;
MSTPROC(DGDFN) ;
;If the MST status is "Y", and the patient is OTH-90, a MailMan message is sent to the DGEN ELIGIBILITY ALERT group
;
;Input parameters:
; DGDFN = IEN of patient in file #2
;
N DGMSG,DGOTH,DGSSN,Z
; check if the patient is OTH-90, if not then quit
; if updated by Z11 HL7 message, patient could be OTH-EXT already, but file 33 has not been updated yet
; so, check if latest elig, change in 33.02 still says OTH-90 while field 2/.5501 is already OTH-EXT
S DGOTH=$$GETEXPMH^DGOTHD(DGDFN) Q:DGOTH=""
S Z=$$LASTELIG^DGOTHEL(DGDFN)
S DGOTH=$$ISOTH^DGOTHD(DGOTH) Q:'DGOTH ; 1 = OTH-EXT, 2 = OTH-90
I DGOTH=1,Z'=0,$$GET1^DIQ(33.02,$P(Z,U,2)_","_$P(Z,U)_",",.03,"I")'="OTH-90" Q
S DGMSG(1)="Patient Name: "_$$GET1^DIQ(2,DGDFN_",",.01)
S DGMSG(2)=" "
S DGMSG(3)="DOB: "_$$GET1^DIQ(2,DGDFN_",",.03)
S DGMSG(4)=" "
S DGMSG(5)="SEX: "_$$GET1^DIQ(2,DGDFN_",",.02)
S DGMSG(6)=" "
S DGMSG(7)="VPID: "_$$GET1^DIQ(2,DGDFN_",",991.1)
S DGMSG(8)=" "
S DGMSG(9)="DFN: "_DGDFN
S DGMSG(10)=" "
S DGMSG(11)="STATION NUMBER: "_$P($$SITE^VASITE(),U,3)
S DGMSG(12)=" "
S DGMSG(13)=" "
S DGMSG(14)="This Veteran's EXPANDED MH CARE TYPE has been"
S DGMSG(15)="automatically changed from OTH-90 to OTH-EXT because"
S DGMSG(16)="their MST Clinical Reminder Screening resulted in a"
S DGMSG(17)="Positive response. EXPANDED MH CARE TYPE has been changed"
S DGMSG(18)=" "
S DGMSG(19)="Note: If 'STATUS ENTERED BY' field is blank on Registration Eligibility"
S DGMSG(20)=" Verification Screen #11, it is due to Provider Name not being"
S DGMSG(21)=" available when the MST Screening CR was processed in CPRS."
D SENDMSG(.DGMSG,"VistA Registration Information has been updated automatically")
Q
;
SENDMSG(DGMSG,XMSUB) ;Send MailMan message to DGEN ELIGIBILITY ALERT group
N XMDUZ,XMTEXT,XMY
S XMDUZ="POSTMASTER",XMTEXT="DGMSG(",XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
D ^XMD ; Returns: XMZ(if no error),XMMG(if error)
Q
;
GETFREQ(DFN) ;
;This Extrinsic API is called from PXRM processing where frequency of the clinical reminder
;is determined. If the patient is OTH, the API will override the frequency computed
;by the Clinical Reminder application during patient cohort logic, if MST Screening
;has taken place, and the patient declined to answer.
;
;Input parameter:
; DGDFN = IEN of patient in file #2
;
N DA,DGDFN,DGSTAT,EXPMHCT
Q:DFN="" ""
S EXPMHCT=$$GETEXPMH^DGOTHD(DFN) Q:EXPMHCT="" ""
Q:'$$ISOTH^DGOTHD(EXPMHCT) ""
;Patient is OTH
;Check last MST Screening entry in the MST HISTORY file (#29.11)
S DA=$O(^DGMS(29.11,"C",DFN,""),-1) Q:DA="" ""
S DGSTAT=$$GET1^DIQ(29.11,DA_",",3,"I") Q:DGSTAT'="D" ""
Q "1Y"
;
UPDELIG ; update eligibility fields in file 2 when MST status changes
; called from "AD" index in file 29.11
; X() array is defined in the index
;
N DGERR,DGFDA,DGNOW,DGOTH,IEN33,IEN3302,IENS,Z
;check if the patient is OTH-90, if not then quit
I +X(2)'>0 Q ; no valid DFN
I X(3)'="Y" Q ; quit if MST status is not "yes"
S IENS=X(2)_","
S DGOTH=$$ISOTH^DGOTHD($$GETEXPMH^DGOTHD(X(2))) Q:'DGOTH ; 1 = OTH-EXT, 2 = OTH-90
S Z=$$LASTELIG^DGOTHEL(X(2)),IEN33=+$P(Z,U),IEN3302=+$P(Z,U,2) I IEN33=0!(IEN3302=0) Q
; if OTH-EXT and it's the first eligibility change (not an OTH-90/OTH-EXT flip), bail out
I DGOTH=1,$O(^DGOTH(33,IEN33,2,IEN3302),-1)=0 Q
S DGFDA(2,IENS,.3616)=X(4) D FILE^DIE(,"DGFDA","DGERR") K DGFDA Q:$D(DGERR)
; if OTH-EXT and last eligibility in 33.02 is not OTH-90, then we just flipped from OTH-90 to OTH-EXT - bail out
I DGOTH=1,$$GET1^DIQ(33.02,IEN3302_","_IEN33_",",.03,"I")'="OTH-90" Q
; if provider = postmaster, then this update came from incoming Z11 message - leave eligibility fields as-is.
I X(4)=".5" Q
S DGNOW=$$NOW^XLFDT() ; DG*5.3*1016
S DGFDA(2,IENS,.3611)="V"
S DGFDA(2,IENS,.3612)=$P(X(1),".")
; have to set 2/.3616 a second time here due to the trigger in field 2/.3611 populating 2/.3616 with DUZ
S DGFDA(2,IENS,.3616)=X(4) D FILE^DIE(,"DGFDA","DGERR")
S DGFDA(2,IENS,.5501)="OTH-EXT"
S DGFDA(2,IENS,.5502)=DGNOW ; DG*5.3*1016
D FILE^DIE(,"DGFDA","DGERR") I $D(DGERR) Q
D EVENT^IVMPLOG(X(2)) ;Update IVM PATIENT file (#301.5) to send HL7 message to ES
D CRTEELCH^DGOTHEL(X(2),$$HASENTRY^DGOTHD2(X(2)),DGNOW) ; DG*5.3*1016
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHMST 8255 printed Oct 16, 2024@18:47:35 Page 2
DGOTHMST ;SLC/MKN - OTH PROCESSING FOLLOWING MST SCREENING ; 06/21/2019
+1 ;;5.3;Registration;**977,1016**;Aug 13, 1993;Build 6
+2 ;
+3 ;OTH processing following MST Screening
+4 ;
MSTCHNG(DA) ; DG*5.3*1016
+1 ;This API is called when MST Screening changes and, if the previous status was "Y"
+2 ;and the new status is either "N" or "D", a MailMan message is sent to the DGEN ELIGIBILITY ALERT group
+3 ;
+4 ;Input Parameter:
+5 ; DA = IEN of entry in file #29.11
+6 ;
+7 NEW DGDFN,DGPREDTM,DGPREST,DGSSN,IEN2911,IENS,IENS2,PATDATA
+8 SET DGDFN=$$GET1^DIQ(29.11,DA_",",2,"I")
if 'DGDFN
QUIT
+9 ; current MST status is "YES"
IF $$GET1^DIQ(29.11,DA_",",3,"I")="Y"
DO MSTPROC(DGDFN)
QUIT
+10 ; primary eligibility is not Expanded MH Care
IF '$$ISOTHD^DGOTHD(DGDFN)
QUIT
+11 ; MH care type (2/.5501) is not OTH-EXT
IF $$GETEXPMH^DGOTHD(DGDFN)'="OTH-EXT"
QUIT
+12 ; quit if previous MST status is not "YES"
+13 SET IEN2911=$ORDER(^DGMS(29.11,"C",DGDFN,DA),-1)
if 'IEN2911
QUIT
+14 SET IENS=IEN2911_","
+15 SET DGPREST=$$GET1^DIQ(29.11,IENS,3,"I")
if DGPREST'="Y"
QUIT
+16 ;
+17 ; timestamp of the previous MST status
SET DGPREDTM=$$GET1^DIQ(29.11,IENS,.01,"I")
+18 SET IENS2=DGDFN_","
DO GETS^DIQ(2,IENS2,".01;.02;.03;.09;.5502;991.01","EI","PATDATA")
IF '$DATA(PATDATA)
QUIT
+19 ; if previous MST status change happened while primary eligibility was Expanded MH Care and last MH care type change was not automatic, quit
+20 IF '$$CHKELIG(DGDFN,DGPREDTM)&'$$CHKADTM(DGDFN,PATDATA(2,IENS2,.5502,"I"))
QUIT
+21 ;
+22 SET DGSSN=PATDATA(2,IENS2,.09,"E")
+23 SET DGMSG(1)="Eligibility personnel should re-evaluate this Patient's"
+24 SET DGMSG(2)="Expanded MH Care Type as their MST Screening CR has been"
+25 SET DGMSG(3)="changed from positive to negative/decline."
+26 SET DGMSG(4)=" "
+27 SET DGMSG(5)="Patient Name: "_PATDATA(2,IENS2,.01,"E")
+28 SET DGMSG(6)=" "
+29 SET DGMSG(7)="SSN: "_$EXTRACT(DGSSN,$LENGTH(DGSSN)-3,$LENGTH(DGSSN))
+30 SET DGMSG(8)=" "
+31 SET DGMSG(9)="DOB: "_PATDATA(2,IENS2,.03,"E")
+32 SET DGMSG(10)=" "
+33 SET DGMSG(11)="SEX: "_PATDATA(2,IENS2,.02,"E")
+34 SET DGMSG(12)=" "
+35 SET DGMSG(13)="VPID: "_PATDATA(2,IENS2,991.01,"E")
+36 SET DGMSG(14)=" "
+37 SET DGMSG(15)="DFN: "_DGDFN
+38 SET DGMSG(16)=" "
+39 SET DGMSG(17)="STATION NUMBER: "_$PIECE($$SITE^VASITE(),U,3)
+40 SET DGMSG(18)=" "
+41 DO SENDMSG(.DGMSG,"Eligibility re-evaluation needed.")
+42 QUIT
+43 ;
CHKADTM(DGDFN,AUTODTM) ; check if last MH care type change was automatic DG*5.3*1016
+1 ;
+2 ; DGDFN - patient's DFN
+3 ; AUTODTM - timestamp of automatic MH care type change (from 2/.5502)
+4 ;
+5 ; returns: 1 if last MH care type change was automatic,
+6 ; 0 if last MH care type change was not automatic,
+7 ; -1 if error was encountered
+8 ;
+9 NEW IEN33,LASTDTM
+10 ; invalid DFN
IF +DGDFN'>0
QUIT -1
+11 ; no entry in file 33
SET IEN33=$ORDER(^DGOTH(33,"B",DGDFN,""))
IF 'IEN33
QUIT -1
+12 ; no automatic change timestamp
IF 'AUTODTM
QUIT 0
+13 ; timestamp of last eligibility change from sub-file 33.02
SET LASTDTM=+$ORDER(^DGOTH(33,IEN33,2,"B",""),-1)
+14 ; timestamps don't match
IF $$FMDIFF^XLFDT(LASTDTM,AUTODTM,2)'=0
QUIT 0
+15 QUIT 1
+16 ;
CHKELIG(DGDFN,MSTDTM) ; check if given MST status change happened while primary eligibility was not Expanded MH Care DG*5.3*1016
+1 ;
+2 ; DGDFN - patient's DFN
+3 ; MSTDTM - timestamp of the MST status change (from 29.11/.01)
+4 ;
+5 ; returns: 1 if MST status change happened while primary eligibility was not Expanded MH Care,
+6 ; 0 if MST status change happened while primary eligibility was Expanded MH Care,
+7 ; -1 if error was encountered
+8 ;
+9 NEW DGDTM,IEN33,IEN3302
+10 ; invalid DFN
IF +DGDFN'>0
QUIT -1
+11 ; invalid MST timestamp
IF +MSTDTM'>0
QUIT -1
+12 ; no entry in file 33
SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF 'IEN33
QUIT -1
+13 ; no prior eligibility change in file 33 = patient was not OTH
SET DGDTM=+$ORDER(^DGOTH(33,IEN33,2,"B",MSTDTM),-1)
IF 'DGDTM
QUIT 1
+14 SET IEN3302=+$ORDER(^DGOTH(33,IEN33,2,"B",DGDTM,""))
IF 'IEN3302
QUIT 1
+15 ; prior eligibility change was not OTH
IF $$GET1^DIQ(33.02,IEN3302_","_IEN33_",",.02)'="EXPANDED MH CARE NON-ENROLLEE"
QUIT 1
+16 QUIT 0
+17 ;
MSTPROC(DGDFN) ;
+1 ;If the MST status is "Y", and the patient is OTH-90, a MailMan message is sent to the DGEN ELIGIBILITY ALERT group
+2 ;
+3 ;Input parameters:
+4 ; DGDFN = IEN of patient in file #2
+5 ;
+6 NEW DGMSG,DGOTH,DGSSN,Z
+7 ; check if the patient is OTH-90, if not then quit
+8 ; if updated by Z11 HL7 message, patient could be OTH-EXT already, but file 33 has not been updated yet
+9 ; so, check if latest elig, change in 33.02 still says OTH-90 while field 2/.5501 is already OTH-EXT
+10 SET DGOTH=$$GETEXPMH^DGOTHD(DGDFN)
if DGOTH=""
QUIT
+11 SET Z=$$LASTELIG^DGOTHEL(DGDFN)
+12 ; 1 = OTH-EXT, 2 = OTH-90
SET DGOTH=$$ISOTH^DGOTHD(DGOTH)
if 'DGOTH
QUIT
+13 IF DGOTH=1
IF Z'=0
IF $$GET1^DIQ(33.02,$PIECE(Z,U,2)_","_$PIECE(Z,U)_",",.03,"I")'="OTH-90"
QUIT
+14 SET DGMSG(1)="Patient Name: "_$$GET1^DIQ(2,DGDFN_",",.01)
+15 SET DGMSG(2)=" "
+16 SET DGMSG(3)="DOB: "_$$GET1^DIQ(2,DGDFN_",",.03)
+17 SET DGMSG(4)=" "
+18 SET DGMSG(5)="SEX: "_$$GET1^DIQ(2,DGDFN_",",.02)
+19 SET DGMSG(6)=" "
+20 SET DGMSG(7)="VPID: "_$$GET1^DIQ(2,DGDFN_",",991.1)
+21 SET DGMSG(8)=" "
+22 SET DGMSG(9)="DFN: "_DGDFN
+23 SET DGMSG(10)=" "
+24 SET DGMSG(11)="STATION NUMBER: "_$PIECE($$SITE^VASITE(),U,3)
+25 SET DGMSG(12)=" "
+26 SET DGMSG(13)=" "
+27 SET DGMSG(14)="This Veteran's EXPANDED MH CARE TYPE has been"
+28 SET DGMSG(15)="automatically changed from OTH-90 to OTH-EXT because"
+29 SET DGMSG(16)="their MST Clinical Reminder Screening resulted in a"
+30 SET DGMSG(17)="Positive response. EXPANDED MH CARE TYPE has been changed"
+31 SET DGMSG(18)=" "
+32 SET DGMSG(19)="Note: If 'STATUS ENTERED BY' field is blank on Registration Eligibility"
+33 SET DGMSG(20)=" Verification Screen #11, it is due to Provider Name not being"
+34 SET DGMSG(21)=" available when the MST Screening CR was processed in CPRS."
+35 DO SENDMSG(.DGMSG,"VistA Registration Information has been updated automatically")
+36 QUIT
+37 ;
SENDMSG(DGMSG,XMSUB) ;Send MailMan message to DGEN ELIGIBILITY ALERT group
+1 NEW XMDUZ,XMTEXT,XMY
+2 SET XMDUZ="POSTMASTER"
SET XMTEXT="DGMSG("
SET XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
+3 ; Returns: XMZ(if no error),XMMG(if error)
DO ^XMD
+4 QUIT
+5 ;
GETFREQ(DFN) ;
+1 ;This Extrinsic API is called from PXRM processing where frequency of the clinical reminder
+2 ;is determined. If the patient is OTH, the API will override the frequency computed
+3 ;by the Clinical Reminder application during patient cohort logic, if MST Screening
+4 ;has taken place, and the patient declined to answer.
+5 ;
+6 ;Input parameter:
+7 ; DGDFN = IEN of patient in file #2
+8 ;
+9 NEW DA,DGDFN,DGSTAT,EXPMHCT
+10 if DFN=""
QUIT ""
+11 SET EXPMHCT=$$GETEXPMH^DGOTHD(DFN)
if EXPMHCT=""
QUIT ""
+12 if '$$ISOTH^DGOTHD(EXPMHCT)
QUIT ""
+13 ;Patient is OTH
+14 ;Check last MST Screening entry in the MST HISTORY file (#29.11)
+15 SET DA=$ORDER(^DGMS(29.11,"C",DFN,""),-1)
if DA=""
QUIT ""
+16 SET DGSTAT=$$GET1^DIQ(29.11,DA_",",3,"I")
if DGSTAT'="D"
QUIT ""
+17 QUIT "1Y"
+18 ;
UPDELIG ; update eligibility fields in file 2 when MST status changes
+1 ; called from "AD" index in file 29.11
+2 ; X() array is defined in the index
+3 ;
+4 NEW DGERR,DGFDA,DGNOW,DGOTH,IEN33,IEN3302,IENS,Z
+5 ;check if the patient is OTH-90, if not then quit
+6 ; no valid DFN
IF +X(2)'>0
QUIT
+7 ; quit if MST status is not "yes"
IF X(3)'="Y"
QUIT
+8 SET IENS=X(2)_","
+9 ; 1 = OTH-EXT, 2 = OTH-90
SET DGOTH=$$ISOTH^DGOTHD($$GETEXPMH^DGOTHD(X(2)))
if 'DGOTH
QUIT
+10 SET Z=$$LASTELIG^DGOTHEL(X(2))
SET IEN33=+$PIECE(Z,U)
SET IEN3302=+$PIECE(Z,U,2)
IF IEN33=0!(IEN3302=0)
QUIT
+11 ; if OTH-EXT and it's the first eligibility change (not an OTH-90/OTH-EXT flip), bail out
+12 IF DGOTH=1
IF $ORDER(^DGOTH(33,IEN33,2,IEN3302),-1)=0
QUIT
+13 SET DGFDA(2,IENS,.3616)=X(4)
DO FILE^DIE(,"DGFDA","DGERR")
KILL DGFDA
if $DATA(DGERR)
QUIT
+14 ; if OTH-EXT and last eligibility in 33.02 is not OTH-90, then we just flipped from OTH-90 to OTH-EXT - bail out
+15 IF DGOTH=1
IF $$GET1^DIQ(33.02,IEN3302_","_IEN33_",",.03,"I")'="OTH-90"
QUIT
+16 ; if provider = postmaster, then this update came from incoming Z11 message - leave eligibility fields as-is.
+17 IF X(4)=".5"
QUIT
+18 ; DG*5.3*1016
SET DGNOW=$$NOW^XLFDT()
+19 SET DGFDA(2,IENS,.3611)="V"
+20 SET DGFDA(2,IENS,.3612)=$PIECE(X(1),".")
+21 ; have to set 2/.3616 a second time here due to the trigger in field 2/.3611 populating 2/.3616 with DUZ
+22 SET DGFDA(2,IENS,.3616)=X(4)
DO FILE^DIE(,"DGFDA","DGERR")
+23 SET DGFDA(2,IENS,.5501)="OTH-EXT"
+24 ; DG*5.3*1016
SET DGFDA(2,IENS,.5502)=DGNOW
+25 DO FILE^DIE(,"DGFDA","DGERR")
IF $DATA(DGERR)
QUIT
+26 ;Update IVM PATIENT file (#301.5) to send HL7 message to ES
DO EVENT^IVMPLOG(X(2))
+27 ; DG*5.3*1016
DO CRTEELCH^DGOTHEL(X(2),$$HASENTRY^DGOTHD2(X(2)),DGNOW)
+28 QUIT
