DGOTHEL ;SLC/MKN - OTHD (OTHER THAN HONORABLE DISCHARGE) ELIGIBILITY CHANGES ;Mar 13, 2019@08:07
;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
; ICR# TYPE DESCRIPTION
;------ ---- -----------
; 2056 Sup GET1^DIQ
; 10015 Sup GETS^DIQ
; 10026 Sup ^DIR
;
;This API is called by the DG LOAD EDIT SCREEN 7 Input Template after the Primary Eligibility
;has been entered/changed or the Eligibility Factor has been changed to save to the
;ELIGIBILITY CHANGES multiple in file #33
CRTEELCH(DGDFN,DGIEN,DGDT) ;
;Input parameters:
; DGDFN The IEN of the patient in file #2
; DGIEN If it contains a number, it is the IEN of the entry in file #33
; Otherwise we need to check if there is an entry and use it if necessary
; DGDT Date of activity
;Result:
; 0 No entry necessary - no change in Primary Eligibility
; 1 An entry was made to subfile #33.02
; -1^Message The update failed
;
N DGEH,DGEL,DGERR,DGEX,DGFDA,DGIEN33,DGIENS,DGLAST,DGPEX,DGPREEL,DGQUIT,DGREASON,DGX
;If DGIEN is null, this call came from the start of XPANDED^DGOTHD1
S DGIEN33=DGIEN,DGQUIT=0 I 'DGIEN S DGIEN33=$$HASENTRY^DGOTHD2(DGDFN) Q:'DGIEN33 0
S DGREASON=""
S DGPEX=$$GET1^DIQ(2,DGDFN_",",.5501,"I")
;Check the EXPANDED MH CARE TYPE that was just updated to see if it changed from
; the last entry in #33.02. If it did, we need to make another entry in #33.02.
S DGPREEL=$$GET1^DIQ(2,DGDFN_",",.361)
S DGLAST=+$P($G(^DGOTH(33,DGIEN33,2,0)),U,3)
I DGLAST>0 K DGEH D GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
I DGLAST,DGPREEL'=$G(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E")) S DGQUIT=1 Q ;Only file if Primary Eligibility is same
I DGLAST,DGPEX=$G(DGEH(33.02,DGLAST_","_DGIEN33_",",.03,"I")) S DGQUIT=1 Q ;Only file if Expanded MH Care code changed
S DGREASON=$$RSN4CHG(DGIEN33)
Q:DGQUIT 0
S DGERR=0 I DGIEN33 D
.S DGIENS=DGIEN33_"," D
..;If last entry was missing the EXPANDED MH CARE TYPE, update that entry
..I DGLAST,$G(DGEH(33.02,DGLAST_","_DGIEN33_",",.03,"I"))="" S DGIENS=DGLAST_","_DGIENS
..E S DGIENS="+1,"_DGIENS
.S DGFDA(33.02,DGIENS,.01)=DGDT
.S DGFDA(33.02,DGIENS,.02)=$$GET1^DIQ(2,DGDFN_",",.361,"I")
.S DGFDA(33.02,DGIENS,.03)=$$GET1^DIQ(2,DGDFN_",",.5501,"I")
.S DGFDA(33.02,DGIENS,.04)=DGREASON
.S DGFDA(33.02,DGIENS,.05)=+$$SITE^VASITE()
.S DGFDA(33.02,DGIENS,.06)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER") ;the user name, otherwise - POSTMASTER
.D UPDATE^DIE("","DGFDA","","DGERR")
I DGERR Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1),"Update Error")
Q 1
;
;Get reason for change to EXPANDED MH CARE TYPE
RSN4CHG(DGIEN33) ;
N DGINIT,DGN
S (DGINIT,DGN)=0 F S DGN=$O(^DGOTH(33,DGIEN33,2,DGN)) Q:'DGN!(DGINIT) D
.S DGINIT='$$GET1^DIQ(33.02,DGN_","_DGIEN33_",",.04,"I")
I DGINIT Q 1
Q 0
;
;This API is called from the "AG" cross-reference in the PATIENT file #2 filed .361 (PRIMARY ELIGIBILITY)
INACT33(DFN) ;
;Next line is to preserve certain variables that are used by ^DIE and are needed in DGRPX73
;(DGRPX73 is a generated routine on field #2,#.361 PRIMARY ELIGIBILITY)
N DA,DGEH,DGELIG,DGERR,DGFDA,DGIEN33,DGIENS,DGLAST,DGPREEL,DIE,DP,DQ,DR
S DGELIG=$$GET1^DIQ(2,DFN_",",.361,"E")
I DGELIG="EXPANDED MH CARE NON-ENROLLEE" D SETACTVE Q
I DGELIG="" D EMHCT^DGOTHD1(DFN)
D DEACTIVE
Q
;
DEACTIVE ;
S DGIEN33=$O(^DGOTH(33,"B",DFN,"")) Q:'DGIEN33
;Inactivate the clock entry if it exists
;Note: This is a hard set because INACT33 is called from index #2,#.361 "AG", and ^DIE was killing
;various FileMan variables that the generated routines needed
S $P(^DGOTH(33,DGIEN33,0),U,2)=0 D EMHCT^DGOTHD1(DFN)
;Now check if last history entry was for EXPANDED MH CARE NON-ENROLLEE, and make new one for this P.E.
S DGLAST=+$P($G(^DGOTH(33,DGIEN33,2,0)),U,3) Q:'DGLAST
K DGEH D GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
S DGPREEL=$G(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E"))
I DGPREEL="EXPANDED MH CARE NON-ENROLLEE" D
.S DGERR=0
.S DGIENS=DGIEN33_","
.S DGFDA(33.02,"+1,"_DGIENS,.01)=$$NOW^XLFDT()
.S DGFDA(33.02,"+1,"_DGIENS,.02)=$$GET1^DIQ(2,DFN_",",.361,"I")
.S DGFDA(33.02,"+1,"_DGIENS,.03)=$$GET1^DIQ(2,DFN_",",.5501,"I")
.S DGFDA(33.02,"+1,"_DGIENS,.04)=1
.S DGFDA(33.02,"+1,"_DGIENS,.05)=+$$SITE^VASITE()
.S DGFDA(33.02,"+1,"_DGIENS,.06)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER") ;the user name, otherwise - POSTMASTER
.D UPDATE^DIE("","DGFDA","","DGERR")
Q
;
SETACTVE ;
S DGIEN33=$O(^DGOTH(33,"B",DFN,"")) Q:'DGIEN33
;Activate the clock entry if it exists
;Note: This is a hard set because INACT33 is called from index #2,#.361 "AG", and ^DIE was killing
;various FileMan variables that the generated routines needed
S $P(^DGOTH(33,DGIEN33,0),U,2)=1
;Now check if last history entry was not for EXPANDED MH CARE NON-ENROLLEE, and if so make new one
S DGLAST=+$P($G(^DGOTH(33,DGIEN33,2,0)),U,3) Q:'DGLAST
K DGEH D GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
S DGPREEL=$G(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E"))
I DGPREEL'="EXPANDED MH CARE NON-ENROLLEE" D
.S DGERR=0
.S DGIENS=DGIEN33_","
.S DGFDA(33.02,"+1,"_DGIENS,.01)=$$NOW^XLFDT()
.S DGFDA(33.02,"+1,"_DGIENS,.02)=$$GET1^DIQ(2,DFN_",",.361,"I")
.S DGFDA(33.02,"+1,"_DGIENS,.03)=$$GET1^DIQ(2,DFN_",",.5501,"I")
.S DGFDA(33.02,"+1,"_DGIENS,.04)=1
.S DGFDA(33.02,"+1,"_DGIENS,.05)=+$$SITE^VASITE()
.S DGFDA(33.02,"+1,"_DGIENS,.06)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER") ;the user name, otherwise - POSTMASTER
.D UPDATE^DIE("","DGFDA","","DGERR")
Q
;
GETTIMST(DFN) ;
;Get Timestamp for latest entry in #33.02 where PRIMARY ELIGIBILITY or EXPANDED MH CARE TYPE has changed
N DGELL,DGELP,DGIEN33,DGIENS,DGLAST,DGN,DGNP,DQUIT,DGTYPEL,DGTYPEP
S DGIEN33=$O(^DGOTH(33,"B",DFN,"")) Q:'DGIEN33 ""
S DGLAST=+$P($G(^DGOTH(33,DGIEN33,2,0)),U,3) Q:'DGLAST ""
S DQUIT="" F DGN=DGLAST:-1:1 D Q:DGQUIT
. S DGIENS=DGN_","_DGIEN33_","
. S DGELL=$$GET1^DIQ(33.02,DGIENS,.02),DGTYPEL=$$GET1^DIQ(33.02,DGIENS,.03)
. S DGNP=$O(^DGOTH(33,DGIEN33,2,DGN),-1) I 'DGNP S DGQUIT=$$GET1^DIQ(33.02,DGIENS,.01,"I") Q
. S DGIENS=DGNP_","_DGIEN33_","
. S DGELP=$$GET1^DIQ(33.02,DGIENS,.02),DGTYPEP=$$GET1^DIQ(33.02,DGIENS,.03)
. I DGELL'=DGELP!(DGTYPEL'=DGTYPEP) S DGQUIT=$$GET1^DIQ(33.02,DGN_","_DGIEN33_",",.01,"I") Q
Q DGQUIT
;
CHKDGEN(DGDFN) ;If Expanded MH Care Type has changed from one type to another, send MailMan message
N DGCH,DGHIST,DGIEN33,DGLAST,DGMSG,DGN,DGX,DGY,XMDUZ,XMSUB,XMTEXT,XMY
S DGIEN33=$$HASENTRY^DGOTHD2(DGDFN) Q:'DGIEN33
S DGLAST=+$P($G(^DGOTH(33,DGIEN33,2,0)),U,3) Q:'DGLAST ""
D GETS^DIQ(33,DGIEN33_",","2*","IE","DGHIST")
F DGN=DGLAST:-1:1 S DGX=$G(DGHIST(33.02,DGN_","_DGIEN33_",",.03,"E")) I DGX]"" S DGCH=U_DGX Q
Q:DGCH=""
F DGN=(DGN-1):-1:1 S DGY=$G(DGHIST(33.02,DGN_","_DGIEN33_",",.03,"E")) D:DGY]""&(DGY'=$P(DGCH,U,2)) Q
.S $P(DGCH,U)=DGY
Q:$P(DGCH,U)=""!($P(DGCH,U,2)="")
;Send MailMan message to DGEN ELIGIBILITY ALERT mail group
S DGMSG(1)="Patient "_$$GET1^DIQ(2,DGDFN_",",.01)_": "
S DGMSG(2)="Please note that the Expanded MH Care Type for this"
S DGMSG(3)="patient was changed from "_$P(DGCH,U)_" to"
S DGMSG(4)=$P(DGCH,U,2)_"."
S XMSUB="Expanded MH Care Type was changed"
S XMDUZ="POSTMASTER",XMTEXT="DGMSG(",XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
D ^XMD ; Returns: XMZ(if no error),XMMG(if error)
Q
;
CLEAN ;
N DA,DGERR,DGIEN33,DGIEN332,DGFAC,DIE
S DGFAC=+$$SITE^VASITE()
S DGIEN33=0 F S DGIEN33=$O(^DGOTH(33,DGIEN33)) Q:'DGIEN33 D
.S DGIEN332=0 F S DGIEN332=$O(^DGOTH(33,DGIEN33,2,DGIEN332)) Q:'DGIEN332 D
..K DGFDA S DGFDA(33.02,DGIEN332_","_DGIEN33_",",.05)=DGFAC D FILE^DIE(,"DGFDA","DGERR")
Q
;
LASTELIG(DFN) ; get last IEN from sub-file 33.02 DG*5.3*977 OTH-EXT
;
; DFN - patient DFN
;
; returns "file 33 IEN ^ IEN of the latest entry in sub-file 33.02" or 0 if no entries are found
;
N DGIEN33,DGTS
S DGIEN33=$O(^DGOTH(33,"B",DFN,"")) Q:'DGIEN33 0
S DGTS=+$O(^DGOTH(33,DGIEN33,2,"B",""),-1)
Q DGIEN33_U_+$O(^DGOTH(33,DGIEN33,2,"B",DGTS,""))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHEL 8231 printed Dec 13, 2024@02:46:48 Page 2
DGOTHEL ;SLC/MKN - OTHD (OTHER THAN HONORABLE DISCHARGE) ELIGIBILITY CHANGES ;Mar 13, 2019@08:07
+1 ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; ICR# TYPE DESCRIPTION
+5 ;------ ---- -----------
+6 ; 2056 Sup GET1^DIQ
+7 ; 10015 Sup GETS^DIQ
+8 ; 10026 Sup ^DIR
+9 ;
+10 ;This API is called by the DG LOAD EDIT SCREEN 7 Input Template after the Primary Eligibility
+11 ;has been entered/changed or the Eligibility Factor has been changed to save to the
+12 ;ELIGIBILITY CHANGES multiple in file #33
CRTEELCH(DGDFN,DGIEN,DGDT) ;
+1 ;Input parameters:
+2 ; DGDFN The IEN of the patient in file #2
+3 ; DGIEN If it contains a number, it is the IEN of the entry in file #33
+4 ; Otherwise we need to check if there is an entry and use it if necessary
+5 ; DGDT Date of activity
+6 ;Result:
+7 ; 0 No entry necessary - no change in Primary Eligibility
+8 ; 1 An entry was made to subfile #33.02
+9 ; -1^Message The update failed
+10 ;
+11 NEW DGEH,DGEL,DGERR,DGEX,DGFDA,DGIEN33,DGIENS,DGLAST,DGPEX,DGPREEL,DGQUIT,DGREASON,DGX
+12 ;If DGIEN is null, this call came from the start of XPANDED^DGOTHD1
+13 SET DGIEN33=DGIEN
SET DGQUIT=0
IF 'DGIEN
SET DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
if 'DGIEN33
QUIT 0
+14 SET DGREASON=""
+15 SET DGPEX=$$GET1^DIQ(2,DGDFN_",",.5501,"I")
+16 ;Check the EXPANDED MH CARE TYPE that was just updated to see if it changed from
+17 ; the last entry in #33.02. If it did, we need to make another entry in #33.02.
+18 SET DGPREEL=$$GET1^DIQ(2,DGDFN_",",.361)
+19 SET DGLAST=+$PIECE($GET(^DGOTH(33,DGIEN33,2,0)),U,3)
+20 IF DGLAST>0
KILL DGEH
DO GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
+21 ;Only file if Primary Eligibility is same
IF DGLAST
IF DGPREEL'=$GET(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E"))
SET DGQUIT=1
QUIT
+22 ;Only file if Expanded MH Care code changed
IF DGLAST
IF DGPEX=$GET(DGEH(33.02,DGLAST_","_DGIEN33_",",.03,"I"))
SET DGQUIT=1
QUIT
+23 SET DGREASON=$$RSN4CHG(DGIEN33)
+24 if DGQUIT
QUIT 0
+25 SET DGERR=0
IF DGIEN33
Begin DoDot:1
+26 SET DGIENS=DGIEN33_","
Begin DoDot:2
+27 ;If last entry was missing the EXPANDED MH CARE TYPE, update that entry
+28 IF DGLAST
IF $GET(DGEH(33.02,DGLAST_","_DGIEN33_",",.03,"I"))=""
SET DGIENS=DGLAST_","_DGIENS
+29 IF '$TEST
SET DGIENS="+1,"_DGIENS
End DoDot:2
+30 SET DGFDA(33.02,DGIENS,.01)=DGDT
+31 SET DGFDA(33.02,DGIENS,.02)=$$GET1^DIQ(2,DGDFN_",",.361,"I")
+32 SET DGFDA(33.02,DGIENS,.03)=$$GET1^DIQ(2,DGDFN_",",.5501,"I")
+33 SET DGFDA(33.02,DGIENS,.04)=DGREASON
+34 SET DGFDA(33.02,DGIENS,.05)=+$$SITE^VASITE()
+35 ;the user name, otherwise - POSTMASTER
SET DGFDA(33.02,DGIENS,.06)=$SELECT($GET(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER")
+36 DO UPDATE^DIE("","DGFDA","","DGERR")
End DoDot:1
+37 IF DGERR
QUIT "-1^"_$GET(DGERR("DIERR",1,"TEXT",1),"Update Error")
+38 QUIT 1
+39 ;
+40 ;Get reason for change to EXPANDED MH CARE TYPE
RSN4CHG(DGIEN33) ;
+1 NEW DGINIT,DGN
+2 SET (DGINIT,DGN)=0
FOR
SET DGN=$ORDER(^DGOTH(33,DGIEN33,2,DGN))
if 'DGN!(DGINIT)
QUIT
Begin DoDot:1
+3 SET DGINIT='$$GET1^DIQ(33.02,DGN_","_DGIEN33_",",.04,"I")
End DoDot:1
+4 IF DGINIT
QUIT 1
+5 QUIT 0
+6 ;
+7 ;This API is called from the "AG" cross-reference in the PATIENT file #2 filed .361 (PRIMARY ELIGIBILITY)
INACT33(DFN) ;
+1 ;Next line is to preserve certain variables that are used by ^DIE and are needed in DGRPX73
+2 ;(DGRPX73 is a generated routine on field #2,#.361 PRIMARY ELIGIBILITY)
+3 NEW DA,DGEH,DGELIG,DGERR,DGFDA,DGIEN33,DGIENS,DGLAST,DGPREEL,DIE,DP,DQ,DR
+4 SET DGELIG=$$GET1^DIQ(2,DFN_",",.361,"E")
+5 IF DGELIG="EXPANDED MH CARE NON-ENROLLEE"
DO SETACTVE
QUIT
+6 IF DGELIG=""
DO EMHCT^DGOTHD1(DFN)
+7 DO DEACTIVE
+8 QUIT
+9 ;
DEACTIVE ;
+1 SET DGIEN33=$ORDER(^DGOTH(33,"B",DFN,""))
if 'DGIEN33
QUIT
+2 ;Inactivate the clock entry if it exists
+3 ;Note: This is a hard set because INACT33 is called from index #2,#.361 "AG", and ^DIE was killing
+4 ;various FileMan variables that the generated routines needed
+5 SET $PIECE(^DGOTH(33,DGIEN33,0),U,2)=0
DO EMHCT^DGOTHD1(DFN)
+6 ;Now check if last history entry was for EXPANDED MH CARE NON-ENROLLEE, and make new one for this P.E.
+7 SET DGLAST=+$PIECE($GET(^DGOTH(33,DGIEN33,2,0)),U,3)
if 'DGLAST
QUIT
+8 KILL DGEH
DO GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
+9 SET DGPREEL=$GET(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E"))
+10 IF DGPREEL="EXPANDED MH CARE NON-ENROLLEE"
Begin DoDot:1
+11 SET DGERR=0
+12 SET DGIENS=DGIEN33_","
+13 SET DGFDA(33.02,"+1,"_DGIENS,.01)=$$NOW^XLFDT()
+14 SET DGFDA(33.02,"+1,"_DGIENS,.02)=$$GET1^DIQ(2,DFN_",",.361,"I")
+15 SET DGFDA(33.02,"+1,"_DGIENS,.03)=$$GET1^DIQ(2,DFN_",",.5501,"I")
+16 SET DGFDA(33.02,"+1,"_DGIENS,.04)=1
+17 SET DGFDA(33.02,"+1,"_DGIENS,.05)=+$$SITE^VASITE()
+18 ;the user name, otherwise - POSTMASTER
SET DGFDA(33.02,"+1,"_DGIENS,.06)=$SELECT($GET(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER")
+19 DO UPDATE^DIE("","DGFDA","","DGERR")
End DoDot:1
+20 QUIT
+21 ;
SETACTVE ;
+1 SET DGIEN33=$ORDER(^DGOTH(33,"B",DFN,""))
if 'DGIEN33
QUIT
+2 ;Activate the clock entry if it exists
+3 ;Note: This is a hard set because INACT33 is called from index #2,#.361 "AG", and ^DIE was killing
+4 ;various FileMan variables that the generated routines needed
+5 SET $PIECE(^DGOTH(33,DGIEN33,0),U,2)=1
+6 ;Now check if last history entry was not for EXPANDED MH CARE NON-ENROLLEE, and if so make new one
+7 SET DGLAST=+$PIECE($GET(^DGOTH(33,DGIEN33,2,0)),U,3)
if 'DGLAST
QUIT
+8 KILL DGEH
DO GETS^DIQ(33.02,DGLAST_","_DGIEN33_",","**","IE","DGEH")
+9 SET DGPREEL=$GET(DGEH(33.02,DGLAST_","_DGIEN33_",",.02,"E"))
+10 IF DGPREEL'="EXPANDED MH CARE NON-ENROLLEE"
Begin DoDot:1
+11 SET DGERR=0
+12 SET DGIENS=DGIEN33_","
+13 SET DGFDA(33.02,"+1,"_DGIENS,.01)=$$NOW^XLFDT()
+14 SET DGFDA(33.02,"+1,"_DGIENS,.02)=$$GET1^DIQ(2,DFN_",",.361,"I")
+15 SET DGFDA(33.02,"+1,"_DGIENS,.03)=$$GET1^DIQ(2,DFN_",",.5501,"I")
+16 SET DGFDA(33.02,"+1,"_DGIENS,.04)=1
+17 SET DGFDA(33.02,"+1,"_DGIENS,.05)=+$$SITE^VASITE()
+18 ;the user name, otherwise - POSTMASTER
SET DGFDA(33.02,"+1,"_DGIENS,.06)=$SELECT($GET(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"POSTMASTER")
+19 DO UPDATE^DIE("","DGFDA","","DGERR")
End DoDot:1
+20 QUIT
+21 ;
GETTIMST(DFN) ;
+1 ;Get Timestamp for latest entry in #33.02 where PRIMARY ELIGIBILITY or EXPANDED MH CARE TYPE has changed
+2 NEW DGELL,DGELP,DGIEN33,DGIENS,DGLAST,DGN,DGNP,DQUIT,DGTYPEL,DGTYPEP
+3 SET DGIEN33=$ORDER(^DGOTH(33,"B",DFN,""))
if 'DGIEN33
QUIT ""
+4 SET DGLAST=+$PIECE($GET(^DGOTH(33,DGIEN33,2,0)),U,3)
if 'DGLAST
QUIT ""
+5 SET DQUIT=""
FOR DGN=DGLAST:-1:1
Begin DoDot:1
+6 SET DGIENS=DGN_","_DGIEN33_","
+7 SET DGELL=$$GET1^DIQ(33.02,DGIENS,.02)
SET DGTYPEL=$$GET1^DIQ(33.02,DGIENS,.03)
+8 SET DGNP=$ORDER(^DGOTH(33,DGIEN33,2,DGN),-1)
IF 'DGNP
SET DGQUIT=$$GET1^DIQ(33.02,DGIENS,.01,"I")
QUIT
+9 SET DGIENS=DGNP_","_DGIEN33_","
+10 SET DGELP=$$GET1^DIQ(33.02,DGIENS,.02)
SET DGTYPEP=$$GET1^DIQ(33.02,DGIENS,.03)
+11 IF DGELL'=DGELP!(DGTYPEL'=DGTYPEP)
SET DGQUIT=$$GET1^DIQ(33.02,DGN_","_DGIEN33_",",.01,"I")
QUIT
End DoDot:1
if DGQUIT
QUIT
+12 QUIT DGQUIT
+13 ;
CHKDGEN(DGDFN) ;If Expanded MH Care Type has changed from one type to another, send MailMan message
+1 NEW DGCH,DGHIST,DGIEN33,DGLAST,DGMSG,DGN,DGX,DGY,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
if 'DGIEN33
QUIT
+3 SET DGLAST=+$PIECE($GET(^DGOTH(33,DGIEN33,2,0)),U,3)
if 'DGLAST
QUIT ""
+4 DO GETS^DIQ(33,DGIEN33_",","2*","IE","DGHIST")
+5 FOR DGN=DGLAST:-1:1
SET DGX=$GET(DGHIST(33.02,DGN_","_DGIEN33_",",.03,"E"))
IF DGX]""
SET DGCH=U_DGX
QUIT
+6 if DGCH=""
QUIT
+7 FOR DGN=(DGN-1):-1:1
SET DGY=$GET(DGHIST(33.02,DGN_","_DGIEN33_",",.03,"E"))
if DGY]""&(DGY'=$PIECE(DGCH,U,2))
Begin DoDot:1
+8 SET $PIECE(DGCH,U)=DGY
End DoDot:1
QUIT
+9 if $PIECE(DGCH,U)=""!($PIECE(DGCH,U,2)="")
QUIT
+10 ;Send MailMan message to DGEN ELIGIBILITY ALERT mail group
+11 SET DGMSG(1)="Patient "_$$GET1^DIQ(2,DGDFN_",",.01)_": "
+12 SET DGMSG(2)="Please note that the Expanded MH Care Type for this"
+13 SET DGMSG(3)="patient was changed from "_$PIECE(DGCH,U)_" to"
+14 SET DGMSG(4)=$PIECE(DGCH,U,2)_"."
+15 SET XMSUB="Expanded MH Care Type was changed"
+16 SET XMDUZ="POSTMASTER"
SET XMTEXT="DGMSG("
SET XMY("G.DGEN ELIGIBILITY ALERT@"_^XMB("NETNAME"))=""
+17 ; Returns: XMZ(if no error),XMMG(if error)
DO ^XMD
+18 QUIT
+19 ;
CLEAN ;
+1 NEW DA,DGERR,DGIEN33,DGIEN332,DGFAC,DIE
+2 SET DGFAC=+$$SITE^VASITE()
+3 SET DGIEN33=0
FOR
SET DGIEN33=$ORDER(^DGOTH(33,DGIEN33))
if 'DGIEN33
QUIT
Begin DoDot:1
+4 SET DGIEN332=0
FOR
SET DGIEN332=$ORDER(^DGOTH(33,DGIEN33,2,DGIEN332))
if 'DGIEN332
QUIT
Begin DoDot:2
+5 KILL DGFDA
SET DGFDA(33.02,DGIEN332_","_DGIEN33_",",.05)=DGFAC
DO FILE^DIE(,"DGFDA","DGERR")
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
LASTELIG(DFN) ; get last IEN from sub-file 33.02 DG*5.3*977 OTH-EXT
+1 ;
+2 ; DFN - patient DFN
+3 ;
+4 ; returns "file 33 IEN ^ IEN of the latest entry in sub-file 33.02" or 0 if no entries are found
+5 ;
+6 NEW DGIEN33,DGTS
+7 SET DGIEN33=$ORDER(^DGOTH(33,"B",DFN,""))
if 'DGIEN33
QUIT 0
+8 SET DGTS=+$ORDER(^DGOTH(33,DGIEN33,2,"B",""),-1)
+9 QUIT DGIEN33_U_+$ORDER(^DGOTH(33,DGIEN33,2,"B",DGTS,""))
