DGMHVAC ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;6/9/05 11:12
;;5.3;Registration;**903**;Aug 13, 1993;Build 82
;
; Submitted to OSEHRA 04/02/2015 by HP
; All entry points authored by James Harris 2014-2015
;
;
EN(DFN,DGABB) ; Entry point for MHV Enrollment/Registration 'screen'
; Allow editing only if "1" is selected, always begin with Registered? field, since subsequent field logic is dependent
N DIR,DGMHVOUT,DGMHVQ,DGMHVI,DGRSPNS S DGMHVQ=0
F DGMHVI=1:1 Q:$G(DGMHVOUT) D
.I DGMHVI=1&'$G(DGABB) S DGRSPNS=$$DSPENR^DGMHVUTL(DFN,.DGMHVOUT)
.Q:$G(DGMHVOUT)
.D MAIN(DFN,.DGRSPNS)
.S DGRSPNS=$$DSPENR^DGMHVUTL(DFN,.DGMHVOUT)
Q
;
MAIN(DFN,DGABB) ; Main Driver for Enrollment/Registration 'screen'.
; Prompt for three MHV Enrollment/Registration fields - include previously entered values as defaults
; Copy NO value and reason entered at any field to all subsequent fields.
; Do not prompt for subsequent field unless 'YES' is entered at current field.
; (A)ction (in progress) is treated as UNANSWERED.
N DGRPFLD,DGMHV,DGMHAC,DGMHSEL,DGMHVNOW,DGRSNPT,DGRSNTXT,X,Y,DGRNSPT,DGRTFLD
S DGMHAC="",DGMHSEL="",DGMHVNOW=$$NOW^XLFDT
I '$G(DGABB) D CLEAR^DGMHV W !!!
K DIRUT W !
S DGMHVQ=0
;
; Don't ask enrollment/registration question if 'abbreviated' mode and already populated with YES
; Patient MHV Enrolled/Registered?
D ; Enrollment/Registration prompt
.I $G(DGABB)&($G(DGABB)>1) S DGMHV("ENROLLED")=$$GETEN^DGMHVUTL(DFN) Q ; Skip- either abbreviated+already answered, or user selected another
.D ENROLL
Q:$G(DGMHVOUT)!$G(DGMHVQ)
K DIRUT W !
;
; Patient MHV Authenticated?
D ; Authentication prompt
.I $G(DGABB)&($G(DGABB)>2) S DGMHV("AUTH")=$$GETAUTH^DGMHVUTL(DFN) Q
.D AUTHENT
Q:$G(DGMHVOUT)!$G(DGMHVQ)
;
; Secure Messaging
D ; Secure Messaging prompt
.D SECMSG
;
Q
;
ENROLLQ(MHV,DGMHVNOW) ; Prompt for "MHV Enrolled/Registered"
N ENDFLT,DIR,DA,X,Y S Y=""
D CLEAR^DGMHV
W !,"Step 1 of 3: My HealtheVet Registration",!,"----------------------------------------",!
S ENDFLT=$P($G(^DPT(DFN,2)),"^")
S ENDFLT=$S(ENDFLT=1:"YES",ENDFLT=0:"NO",1:"")
S DIR(0)="Y",DIR("B")=ENDFLT
S DIR("A")="Is the patient registered on My HealtheVet (Yes/No)"
K DIRUT D ^DIR Q:$D(DIRUT)
S MHV("ENROLLED")=$S($G(Y):1,1:0)
Q
;
AUTHENQ(MHV,DGMHVNOW) ; Prompt for "MHV Authenticated"
I '$G(MHV("ENROLLED")) S DGMHVQ=1 Q
D CLEAR^DGMHV
W !,"Step 2 of 3: My HealtheVet Authentication Upgrade",!,"-------------------------------------------------------------",!
N AUDFLT,DIR,DA,X,Y,DGTXT,DGTXTCNT
D CANTXT^DGMHVUTL("AUTH",,,71)
W !
S AUDFLT=$P($G(^DPT(DFN,2)),"^",2),AUDFLT=$S(AUDFLT=1:"YES",AUDFLT=0:"NO",AUDFLT=2:"ACTION",1:"")
S DIR(0)="SAO^Y:YES;N:NO;A:ACTION"
S DIR("B")=AUDFLT
S DIR("A",1)="Select (Y) YES if patient already has a Premium My HealtheVet account."
S DIR("A",2)="Select (A) ACTION if patient wants to upgrade to Premium My HealtheVet account."
S DIR("A",3)="Select (N) NO if patient refuses to upgrade to a Premium My HealtheVet account."
S DIR("A",4)=""
S DIR("A")="(Yes/No/(A)ction): "
K DIRUT D ^DIR I $D(DIRUT) W ! Q
S MHV("AUTH")=$S(Y="Y":1,Y="A":2,1:0)
S DGTXT=""
I MHV("AUTH")'=2 S MHV("AUTH","DATE")=DGMHVNOW
I MHV("AUTH")=1 S DGTXT="- Patient already has a Premium My HealtheVet account."
I MHV("AUTH")=0 S DGTXT="- Patient refuses to upgrade to a Premium My HealtheVet account."
I MHV("AUTH")=2 S DGTXT="- Patient would like to upgrade to a Premium My HealtheVet account."
I DGTXT]"" D TXT^DGMHV(DGTXT,50) I $G(MARX) F DGTXTCNT=1:1:+$G(MARX) D
.I DGTXTCNT=1 W MARX(DGTXTCNT) Q
.W !,MARX(DGTXTCNT)
W !
Q
;
OPTINQ(MHV,DGMHVNOW) ; Prompt for "Use MHV Secure Messaging" - Note previous wording was Opt In
I '$G(MHV("AUTH")) S DGMHVQ=1 Q
D CLEAR^DGMHV
W !,"Step 3 of 3: My HealtheVet Secure Messaging",!,"--------------------------------------------",!
N MSGDFLT,DIR,DA,X,Y
D CANTXT^DGMHVUTL("SMSG",,,71)
W !
S MSGDFLT=$P($G(^DPT(DFN,2)),"^",3),MSGDFLT=$S(MSGDFLT=1:"YES",MSGDFLT=0:"NO",MSGDFLT=2:"ACTION",1:"")
S DIR(0)="SAO^Y:YES;N:NO;A:ACTION",DIR("B")=MSGDFLT
S DIR("A",1)="Select (Y) YES if patient already uses Secure Messaging."
S DIR("A",2)="Select (A) ACTION if patient would like to use Secure Messaging."
S DIR("A",3)="Select (N) NO if patient declines to use Secure Messaging."
S DIR("A",4)=""
S DIR("A")="Secure Messaging? (Yes/No/(A)ction): "
K DIRUT D ^DIR I $D(DIRUT) W ! Q
S MHV("OPTINQ")=$S(Y="Y":1,Y="A":2,1:0)
S DGTXT=""
I MHV("OPTINQ")'=2 S MHV("AUTH","DATE")=DGMHVNOW
W !
Q
;
ENROLL ; MHV Enrollment/Registration
D ENROLLQ(.DGMHV,.DGMHVNOW) I $D(DIRUT) S DGMHVOUT=1,DGMHVQ=1 Q
Q:$G(DGMHVOUT)!$G(DGMHVQ)
; MHV Enrolled/Registered
I '$G(DGMHV("ENROLLED")) S DGRNSPT="",DGRSNTXT="" D Q:$G(DGMHVOUT)!$G(DGMHVQ)
.N DGADFLT,UTILITY,DIC,DA,DR S DIC=2,DA=DFN,DR="537036" D GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
.S DGADFLT=$G(UTILITY(2,DFN_",",537036,"I"))
.D GETRSN("patient is not registered",.DGRSNPT,.DGRSNTXT,DGADFLT,2.1) Q:$G(DGMHVOUT)!$G(DGMHVQ)
.I $D(DIRUT)!$G(DGMHVOUT) S DGMHVQ=1,DGMHVOUT=1 Q
.F DGRPFLD=537033:1:537035 D FILRNA(DFN,DGRPFLD,"@")
.F DGRPFLD=537036:1:537038 D FILRNA(DFN,DGRPFLD,DGRSNPT)
.I $P($G(^DGMHV(390.03,DGRSNPT,0)),"^")="Other" F DGRTFLD=537033:1:537035 D FILRNA(DFN,DGRTFLD,DGRSNTXT)
.N DIE,DR,DA S DIE="^DPT(",DR="537027////"_+DGMHV("ENROLLED")_";537030////"_DGMHVNOW,DA=DFN D ^DIE
.N DIE,DR,DA S DA=DFN,DIE="^DPT(",DR="537028////0;537029////0;537031////"_DGMHVNOW_";537032////"_DGMHVNOW D ^DIE
.D FILACT(DFN,3),FILACT(DFN,4)
I $G(DGMHV("ENROLLED")) D
.Q:$G(DGABB)&($P($G(^DPT(DFN,2)),U,1)=1) ; Quit if 'abbreviated' mode and this was answered previously
.N DGOLDEN S DGOLDEN=$P($G(^DPT(DFN,2)),"^")
.N DIE,DA S DIE="^DPT(",DA=DFN,DR="537027////1;537030////"_DGMHVNOW D ^DIE
.Q:DGOLDEN=DGMHV("ENROLLED")
.N DGFLD F DGFLD=537033,537036 D FILRNA(DFN,DGFLD,"@")
.; If "Registered:" changed from NO or Action to YES, remove NO values in AUTHENTICATED and SECURE MESSAGING
.N MHVND S MHVND=$G(^DPT(+DFN,2))
.I $P(MHVND,"^",2)=0 F DGFLD=537028,537031,537034,537037 D FILRNA(DFN,DGFLD,"@")
.I $P(MHVND,"^",3)=0 F DGFLD=537029,537032,537035,537038 D FILRNA(DFN,DGFLD,"@")
Q
;
AUTHENT ; Authenticated MHV account status
D AUTHENQ(.DGMHV,.DGMHVNOW) I $D(DIRUT) S DGMHVOUT=1,DGMHVQ=1 Q
Q:$G(DGMHVOUT)!$G(DGMHVQ)
I '$G(DGMHV("AUTH")) S DGRNSPT="",DGRSNTXT="" D CANTXT^DGMHVUTL("UP",1,1) D Q:$G(DGMHVOUT)!$G(DGMHVQ)
.W !!,"Patient Not Authenticated Reasons"
.N DGADFLT,UTILITY,DIC,DA,DR S DIC=2,DA=DFN,DR="537037" D GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
.S DGADFLT=$G(UTILITY(2,DFN_",",537037,"I"))
.D GETRSN("patient has not upgraded/authenticated",.DGRSNPT,.DGRSNTXT,DGADFLT,2.2) Q:$G(DGMHVOUT)!$G(DGMHVQ)
.I $D(DIRUT)!$G(DGMHVOUT) S DGMHVQ=1,DGMHVOUT=1 Q
.F DGRPFLD=537034,537035 D FILRNA(DFN,DGRPFLD,"@")
.F DGRPFLD=537037,537038 D FILRNA(DFN,DGRPFLD,DGRSNPT)
.I $P($G(^DGMHV(390.03,DGRSNPT,0)),"^")="Other" F DGRTFLD=537034:1:537035 D FILRNA(DFN,DGRTFLD,DGRSNTXT)
.N DIE,DR,DA S DA=DFN
.S DIE="^DPT(",DR="537028////"_DGMHV("AUTH")_";537031////"_DGMHVNOW_";537029////0;537032////"_DGMHVNOW
.D ^DIE
.D FILACT(DFN,3),FILACT(DFN,4)
I $G(DGMHV("AUTH"))=1 D
.N DGOLDAU S DGOLDAU=$P($G(^DPT(DFN,2)),"^",2)
.N DIE,DA S DIE="^DPT(",DA=DFN,DR="537028////1;537031////"_DGMHVNOW D ^DIE
.Q:DGOLDAU=DGMHV("AUTH") ; User accepted default, nothing changed
.;iF AUTHENTICATED is changed to YES then delete all Decline Text / Reason and Action
.F DGFLD=537034,537037 D FILRNA(DFN,DGFLD,"@")
.D FILACT(DFN,4)
.;iF AUTHENTICATED is changed to YES then delete all SECURE MESSAGE elements
.F DGFLD=537029,537032,537035,537038 D FILRNA(DFN,DGFLD,"@")
.D FILACT(DFN,3)
I $G(DGMHV("AUTH"))=2 D CANTXT^DGMHVUTL("UP",,1) D S DGMHVQ=1 Q ; Action entered instead of yes or no
.N DGOLDAU S DGOLDAU=$P($G(^DPT(DFN,2)),"^",2)
.W !! N DGDPTSOC,DGMHSEL S DGDPTSOC=+$O(^DPT(DFN,1,"A"),-1)+1 D ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"A")
.N DGCURSEL S DGCURSEL=$O(DGMHSEL(0)) I 'DGCURSEL Q
.N DIE,DA S DIE="^DPT(",DA=DFN,DR="537028////2;537031////"_DGMHVNOW D ^DIE
.D FILRNA(DFN,537034,"@"),FILRNA(DFN,537037,"@")
.D FILACT(DFN,4,.DGMHSEL)
.Q:DGOLDAU=DGMHV("AUTH")
.;iF AUTHENTICATED is changed to ACTION then delete all SECURE MESSAGE elements
.F DGFLD=537029,537032,537035,537038 D FILRNA(DFN,DGFLD,"@")
.D FILACT(DFN,3)
W !
Q
;
SECMSG ; Secure Messaging
K DIRUT D OPTINQ(.DGMHV,.DGMHVNOW) I $D(DIRUT) S DGMHVOUT=1,DGMHVQ=1
Q:$G(DGMHVOUT)!$G(DGMHVQ)
I '$G(DGMHV("OPTINQ")) S DGRNSPT="",DGRSNTXT="" D Q:$G(DGMHVOUT)
.N DGMDFLT,UTILITY,DIC,DA,DR S DIC=2,DA=DFN,DR="537038" D GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
.S DGMDFLT=$G(UTILITY(2,DFN_",",537038,"I"))
.D GETRSN("not using secure messaging",.DGRSNPT,.DGRSNTXT,DGMDFLT,2.3) Q:$G(DGMHVOUT)!$G(DGMHVQ)
.I $D(DIRUT)!$G(DGMHVOUT) S DGMHVQ=1,DGMHVOUT=1 Q
.D FILRNA(DFN,537035,"@")
.N DIE,DR,DA S DA=DFN,DIE="^DPT(",DR="537029////"_DGMHV("OPTINQ")_";537032////"_DGMHVNOW D ^DIE
.D FILRNA(DFN,537038,DGRSNPT)
.I $P($G(^DGMHV(390.03,DGRSNPT,0)),"^")="Other" D FILRNA(DFN,537035,DGRSNTXT)
.D FILACT(DFN,3)
I $G(DGMHV("OPTINQ"))=1 D Q
.N DIE,DA S DIE="^DPT(",DA=DFN,DR="537029////1;537032////"_DGMHVNOW D ^DIE
.D FILRNA(DFN,537035,"@"),FILRNA(DFN,537038,"@")
.D FILACT(DFN,3)
I $G(DGMHV("OPTINQ"))=2 D Q
.N DGOLDMSG S DGOLDMSG=$$GETMSG^DGMHVUTL(DFN)
.W !! N DGDPTSOC,DGMHSEL S DGDPTSOC=+$O(^DPT(DFN,1,"A"),-1)+1 D ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"M")
.N DGCURSEL S DGCURSEL=$O(DGMHSEL(0)) I 'DGCURSEL D Q
.N DIE,DA S DIE="^DPT(",DA=DFN,DR="537029////2;537032////"_DGMHVNOW D ^DIE
.D FILRNA(DFN,537035,"@"),FILRNA(DFN,537038,"@")
.D FILACT(DFN,3,.DGMHSEL)
Q
;
GETRSN(TXTAD,REASPT,REASTXT,REASDFLT,DGTXTND) ; Prompt for "NO" Reason
N DGDFTXT,DGMSACT,DIR,X,Y K DIRUT,DGTXTFIN,DGSCR
S DGSCR=$S($G(DGTXTND)=2.1:1,$G(DGTXTND)=2.2:2,$G(DGTXTND)=2.3:3,1:"")
S DGDFTXT=$$LKUPRTXT^DGMHVAC(DFN,$G(DGTXTND)),DGTXTFIN=0
D GETRSNS(.DGMSACT,DGSCR)
I $G(REASDFLT) N RSNSEL S RSNSEL="" F S RSNSEL=$O(DGMSACT(RSNSEL)) Q:'RSNSEL I $G(DGMSACT(RSNSEL,"IEN"))=REASDFLT S REASDFLT=RSNSEL
D SETDIR(.DGMSACT,TXTAD,$G(REASDFLT))
S REASPT="" F Q:$G(REASPT)!$G(DGMHVOUT) D ^DIR S:(Y>0) REASPT=+$G(DGMSACT(Y,"IEN")) I 'REASPT D
.N DIR S DIR(0)="Y",DIR("A")="Are you sure you want to quit " D ^DIR I $G(Y)>0 S DGMHVOUT=1
.N UTILITY,DIC,DA,DR S DIC=2,DA=DFN,DR="537038" D GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
.S DGMDFLT=$G(UTILITY(2,DFN_",",537038,"I"))
Q:'$G(REASPT)
I $P($G(^DGMHV(390.03,REASPT,0)),"^")="Other" F Q:$G(DGTXTFIN)!$G(DGMHVQ) D
.N DIR,X,Y S DIR("B")=$G(DGDFTXT),DIR(0)="FAR^2:250",DIR("A")="Other Reason Text (250 Chars Max): " D ^DIR
.I $L(Y)>1 S REASTXT=$TR(Y,";^"," ") S DGTXTFIN=1 Q
.I $G(X)="@" S DGDFTXT="" W " Deleted",!
.I $G(X)="^" S DGMHVQ=1 Q
Q
;
FILRNA(DFN,DGFIELD,DGRSPT) ; File selected NO Reason to Patient file
N DIE,DA,DR
S DIE="^DPT(",DA=DFN,DR=DGFIELD_"////"_DGRSPT D ^DIE
Q
;
FILACT(DFN,DGNODE,DGACTSEL) ; File selected MHV Action(s) to Patient file
N NEXT,DGCNT
S NEXT="A" F S NEXT=$O(^DPT(DFN,DGNODE,NEXT),-1) Q:'NEXT D
.N DIE,DA,DIR S DIE="^DPT("_DFN_","_DGNODE_",",DA(1)=DFN,DA=NEXT,DR=.01_"////@" D ^DIE
S NEXT=0 F DGCNT=1:1 S NEXT=$O(DGACTSEL(NEXT)) Q:'NEXT D
.Q:'$G(DGACTSEL(NEXT,"IEN"))
.N DA,DINUM,X,DIC S DIC(0)="LEZ",DIC="^DPT(DFN,DGNODE,",DA(1)=DFN,DA=DGCNT,DINUM=DA,X=DGACTSEL(NEXT,"IEN") D FILE^DICN
Q
;
GETRSNS(DGMSACT,DGSCRQ) ; Build and return array of selectable reasons from file 390.03
N ACTIEN,ACTCNT,ACTTXT,SELCNT,DGSCR S ACTCNT=0,SELCNT=0
S ACTIEN=0 F S ACTIEN=$O(^DGMHV(390.03,ACTIEN)) Q:'ACTIEN S ACTTXT=$P($G(^DGMHV(390.03,ACTIEN,0)),"^"),DGSCR=$P(^(0),"^",2) I ACTTXT]"" D
.I $G(DGSCRQ),$G(DGSCR) Q:DGSCR'[DGSCRQ
.S ACTCNT=ACTCNT+1,SELCNT=SELCNT+1,DGMSACT(ACTCNT)=ACTTXT,DGMSACT(ACTCNT,"IEN")=ACTIEN
Q
;
SETDIR(DGMSACT,TXTAD,DGMDEF) ; Put incoming array of reasons into DIC("A")
S DIR(0)="SA^",DIR("A",1)="",DIR("B")=$G(DGMDEF)
S ACTCNT=0 F S ACTCNT=$O(DGMSACT(ACTCNT)) Q:'ACTCNT S DIR(0)=DIR(0)_ACTCNT_":"_DGMSACT(ACTCNT)_";",DIR("A",ACTCNT+1)=" "_ACTCNT_" - "_DGMSACT(ACTCNT)
S DIR("A",$O(DIR("A","A"),-1)+1)=""
N LINE,II,MARX,TXL D TXT^DGMHV(TXTAD,30)
I $O(MARX(""),-1)=1 S DIR("A")="Select reason "_TXTAD_": " Q
S TXL=0 F II=1:1 S TXL=$O(MARX(TXL)) Q:'TXL D
.S LINE=$S(II=1:"Select reason ",1:"")_MARX(TXL)
.I $O(MARX(TXL))="" S DIR("A")=LINE Q
.S DIR("A",$O(DIR("A","A"),-1)+1)=""
S DIR("A")="Select reason "_TXTAD_": "
Q
;
MHVOK(DFN) ; Check patient's MHV enrollment/registration info.
; Logic to activate/deactivate alert
; -----------------------------------
; 1. If any field contains null (UNANSWERED), return 0
; 2. If any field contains "A" (ACTION), return 0
; 3. If neither 1 nor 2 is true, and any field contains "N" (NO):
; a. The alert is ON if the date the NO was entered is at least 6 months prior to the current date
; b. The alert is OFF if the date the NO was entered is less than 6 months prior to the current date
; 4. If all fields contain "Y" (YES), return 1
;
N DIR,DGIQ,MHVOK,MHVOKND,MHVEN,MHVBAD,UTILITY
N DIC,DA,DR S DIC=2,DA=DFN,DR="537027:537032" D GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
M MHVOK(DFN)=UTILITY(2,DFN_",")
S MHVBAD=0
F DGIQ=0:1:2 I $G(MHVOK(DFN,537027+DGIQ,"I"))="" S MHVBAD=1
I $G(MHVBAD) Q 0
F DGIQ=0:1:2 Q:$G(MHVBAD) D
.I $G(MHVOK(DFN,537027+DGIQ,"I"))=0 D Q
..I '$G(MHVOK(DFN,537030+DGIQ,"I")) S MHVBAD=1 Q
..I $$FMDIFF^XLFDT($$NOW^XLFDT,MHVOK(DFN,537030+DGIQ,"I"))>179 S MHVBAD=1 D
...N DGQ F DGQ=537027+DGIQ:1:537029 Q:DGQ>537029 D FILRNA(DFN,DGQ,"@")
.I (MHVOK(DFN,537027+DGIQ,"I")="")!(MHVOK(DFN,537027+DGIQ,"I")=2) S MHVBAD=1
Q $S($G(MHVBAD):0,1:1)
;
LKUPRSN(REASON) ; Lookup "NO" Reason in file 390.03
N DIC,X S DIC="390.03",DIC(0)="ZU",X=+REASON D ^DIC
Q $P($G(Y(0)),"^")
;
LKUPRTXT(DFN,DGRFIELD) ; Lookup "OTHER" Reason free text from PATIENT (#2) file
S DGRSNTXT=$P($G(^DPT(+DFN,+DGRFIELD)),"^")
Q $S($L(DGRSNTXT)>1:DGRSNTXT,1:"")
;
LKUPACT(ACTION) ; Lookup MHV Action in file 390.02
N DIC,X S DIC="390.02",DIC(0)="ZU",X=+ACTION D ^DIC
Q $G(Y(0))
Q
;
LASTACHK(DFN,ACTXT) ; Check if ACTXT contains the text matching the most recent ACTION entered for patient DFN
N DGMATCH,DGLST5,DGLST1,DGL1TXT S DGMATCH=0,DGLST5=""
D GETLACT^DGMHVUTL(DFN,.DGLST5) S DGLST1=$O(DGLST5($$NOW^XLFDT),-1)
I $G(DGLST1) D
. S DGL1TXT=$G(DGLST5(DGLST1,1,"TXT",1))
. I $E($G(ACTXT),1,$L($G(DGL1TXT)))=$E($G(DGL1TXT),1,$L($G(DGL1TXT))) S DGMATCH=1
Q $S($G(DGMATCH):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMHVAC 14700 printed Sep 23, 2025@20:20:08 Page 2
DGMHVAC ;HIRMFO/WAA-REACTIONS SELECT ROUTINE ;6/9/05 11:12
+1 ;;5.3;Registration;**903**;Aug 13, 1993;Build 82
+2 ;
+3 ; Submitted to OSEHRA 04/02/2015 by HP
+4 ; All entry points authored by James Harris 2014-2015
+5 ;
+6 ;
EN(DFN,DGABB) ; Entry point for MHV Enrollment/Registration 'screen'
+1 ; Allow editing only if "1" is selected, always begin with Registered? field, since subsequent field logic is dependent
+2 NEW DIR,DGMHVOUT,DGMHVQ,DGMHVI,DGRSPNS
SET DGMHVQ=0
+3 FOR DGMHVI=1:1
if $GET(DGMHVOUT)
QUIT
Begin DoDot:1
+4 IF DGMHVI=1&'$GET(DGABB)
SET DGRSPNS=$$DSPENR^DGMHVUTL(DFN,.DGMHVOUT)
+5 if $GET(DGMHVOUT)
QUIT
+6 DO MAIN(DFN,.DGRSPNS)
+7 SET DGRSPNS=$$DSPENR^DGMHVUTL(DFN,.DGMHVOUT)
End DoDot:1
+8 QUIT
+9 ;
MAIN(DFN,DGABB) ; Main Driver for Enrollment/Registration 'screen'.
+1 ; Prompt for three MHV Enrollment/Registration fields - include previously entered values as defaults
+2 ; Copy NO value and reason entered at any field to all subsequent fields.
+3 ; Do not prompt for subsequent field unless 'YES' is entered at current field.
+4 ; (A)ction (in progress) is treated as UNANSWERED.
+5 NEW DGRPFLD,DGMHV,DGMHAC,DGMHSEL,DGMHVNOW,DGRSNPT,DGRSNTXT,X,Y,DGRNSPT,DGRTFLD
+6 SET DGMHAC=""
SET DGMHSEL=""
SET DGMHVNOW=$$NOW^XLFDT
+7 IF '$GET(DGABB)
DO CLEAR^DGMHV
WRITE !!!
+8 KILL DIRUT
WRITE !
+9 SET DGMHVQ=0
+10 ;
+11 ; Don't ask enrollment/registration question if 'abbreviated' mode and already populated with YES
+12 ; Patient MHV Enrolled/Registered?
+13 ; Enrollment/Registration prompt
Begin DoDot:1
+14 ; Skip- either abbreviated+already answered, or user selected another
IF $GET(DGABB)&($GET(DGABB)>1)
SET DGMHV("ENROLLED")=$$GETEN^DGMHVUTL(DFN)
QUIT
+15 DO ENROLL
End DoDot:1
+16 if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+17 KILL DIRUT
WRITE !
+18 ;
+19 ; Patient MHV Authenticated?
+20 ; Authentication prompt
Begin DoDot:1
+21 IF $GET(DGABB)&($GET(DGABB)>2)
SET DGMHV("AUTH")=$$GETAUTH^DGMHVUTL(DFN)
QUIT
+22 DO AUTHENT
End DoDot:1
+23 if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+24 ;
+25 ; Secure Messaging
+26 ; Secure Messaging prompt
Begin DoDot:1
+27 DO SECMSG
End DoDot:1
+28 ;
+29 QUIT
+30 ;
ENROLLQ(MHV,DGMHVNOW) ; Prompt for "MHV Enrolled/Registered"
+1 NEW ENDFLT,DIR,DA,X,Y
SET Y=""
+2 DO CLEAR^DGMHV
+3 WRITE !,"Step 1 of 3: My HealtheVet Registration",!,"----------------------------------------",!
+4 SET ENDFLT=$PIECE($GET(^DPT(DFN,2)),"^")
+5 SET ENDFLT=$SELECT(ENDFLT=1:"YES",ENDFLT=0:"NO",1:"")
+6 SET DIR(0)="Y"
SET DIR("B")=ENDFLT
+7 SET DIR("A")="Is the patient registered on My HealtheVet (Yes/No)"
+8 KILL DIRUT
DO ^DIR
if $DATA(DIRUT)
QUIT
+9 SET MHV("ENROLLED")=$SELECT($GET(Y):1,1:0)
+10 QUIT
+11 ;
AUTHENQ(MHV,DGMHVNOW) ; Prompt for "MHV Authenticated"
+1 IF '$GET(MHV("ENROLLED"))
SET DGMHVQ=1
QUIT
+2 DO CLEAR^DGMHV
+3 WRITE !,"Step 2 of 3: My HealtheVet Authentication Upgrade",!,"-------------------------------------------------------------",!
+4 NEW AUDFLT,DIR,DA,X,Y,DGTXT,DGTXTCNT
+5 DO CANTXT^DGMHVUTL("AUTH",,,71)
+6 WRITE !
+7 SET AUDFLT=$PIECE($GET(^DPT(DFN,2)),"^",2)
SET AUDFLT=$SELECT(AUDFLT=1:"YES",AUDFLT=0:"NO",AUDFLT=2:"ACTION",1:"")
+8 SET DIR(0)="SAO^Y:YES;N:NO;A:ACTION"
+9 SET DIR("B")=AUDFLT
+10 SET DIR("A",1)="Select (Y) YES if patient already has a Premium My HealtheVet account."
+11 SET DIR("A",2)="Select (A) ACTION if patient wants to upgrade to Premium My HealtheVet account."
+12 SET DIR("A",3)="Select (N) NO if patient refuses to upgrade to a Premium My HealtheVet account."
+13 SET DIR("A",4)=""
+14 SET DIR("A")="(Yes/No/(A)ction): "
+15 KILL DIRUT
DO ^DIR
IF $DATA(DIRUT)
WRITE !
QUIT
+16 SET MHV("AUTH")=$SELECT(Y="Y":1,Y="A":2,1:0)
+17 SET DGTXT=""
+18 IF MHV("AUTH")'=2
SET MHV("AUTH","DATE")=DGMHVNOW
+19 IF MHV("AUTH")=1
SET DGTXT="- Patient already has a Premium My HealtheVet account."
+20 IF MHV("AUTH")=0
SET DGTXT="- Patient refuses to upgrade to a Premium My HealtheVet account."
+21 IF MHV("AUTH")=2
SET DGTXT="- Patient would like to upgrade to a Premium My HealtheVet account."
+22 IF DGTXT]""
DO TXT^DGMHV(DGTXT,50)
IF $GET(MARX)
FOR DGTXTCNT=1:1:+$GET(MARX)
Begin DoDot:1
+23 IF DGTXTCNT=1
WRITE MARX(DGTXTCNT)
QUIT
+24 WRITE !,MARX(DGTXTCNT)
End DoDot:1
+25 WRITE !
+26 QUIT
+27 ;
OPTINQ(MHV,DGMHVNOW) ; Prompt for "Use MHV Secure Messaging" - Note previous wording was Opt In
+1 IF '$GET(MHV("AUTH"))
SET DGMHVQ=1
QUIT
+2 DO CLEAR^DGMHV
+3 WRITE !,"Step 3 of 3: My HealtheVet Secure Messaging",!,"--------------------------------------------",!
+4 NEW MSGDFLT,DIR,DA,X,Y
+5 DO CANTXT^DGMHVUTL("SMSG",,,71)
+6 WRITE !
+7 SET MSGDFLT=$PIECE($GET(^DPT(DFN,2)),"^",3)
SET MSGDFLT=$SELECT(MSGDFLT=1:"YES",MSGDFLT=0:"NO",MSGDFLT=2:"ACTION",1:"")
+8 SET DIR(0)="SAO^Y:YES;N:NO;A:ACTION"
SET DIR("B")=MSGDFLT
+9 SET DIR("A",1)="Select (Y) YES if patient already uses Secure Messaging."
+10 SET DIR("A",2)="Select (A) ACTION if patient would like to use Secure Messaging."
+11 SET DIR("A",3)="Select (N) NO if patient declines to use Secure Messaging."
+12 SET DIR("A",4)=""
+13 SET DIR("A")="Secure Messaging? (Yes/No/(A)ction): "
+14 KILL DIRUT
DO ^DIR
IF $DATA(DIRUT)
WRITE !
QUIT
+15 SET MHV("OPTINQ")=$SELECT(Y="Y":1,Y="A":2,1:0)
+16 SET DGTXT=""
+17 IF MHV("OPTINQ")'=2
SET MHV("AUTH","DATE")=DGMHVNOW
+18 WRITE !
+19 QUIT
+20 ;
ENROLL ; MHV Enrollment/Registration
+1 DO ENROLLQ(.DGMHV,.DGMHVNOW)
IF $DATA(DIRUT)
SET DGMHVOUT=1
SET DGMHVQ=1
QUIT
+2 if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+3 ; MHV Enrolled/Registered
+4 IF '$GET(DGMHV("ENROLLED"))
SET DGRNSPT=""
SET DGRSNTXT=""
Begin DoDot:1
+5 NEW DGADFLT,UTILITY,DIC,DA,DR
SET DIC=2
SET DA=DFN
SET DR="537036"
DO GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
+6 SET DGADFLT=$GET(UTILITY(2,DFN_",",537036,"I"))
+7 DO GETRSN("patient is not registered",.DGRSNPT,.DGRSNTXT,DGADFLT,2.1)
if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+8 IF $DATA(DIRUT)!$GET(DGMHVOUT)
SET DGMHVQ=1
SET DGMHVOUT=1
QUIT
+9 FOR DGRPFLD=537033:1:537035
DO FILRNA(DFN,DGRPFLD,"@")
+10 FOR DGRPFLD=537036:1:537038
DO FILRNA(DFN,DGRPFLD,DGRSNPT)
+11 IF $PIECE($GET(^DGMHV(390.03,DGRSNPT,0)),"^")="Other"
FOR DGRTFLD=537033:1:537035
DO FILRNA(DFN,DGRTFLD,DGRSNTXT)
+12 NEW DIE,DR,DA
SET DIE="^DPT("
SET DR="537027////"_+DGMHV("ENROLLED")_";537030////"_DGMHVNOW
SET DA=DFN
DO ^DIE
+13 NEW DIE,DR,DA
SET DA=DFN
SET DIE="^DPT("
SET DR="537028////0;537029////0;537031////"_DGMHVNOW_";537032////"_DGMHVNOW
DO ^DIE
+14 DO FILACT(DFN,3)
DO FILACT(DFN,4)
End DoDot:1
if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+15 IF $GET(DGMHV("ENROLLED"))
Begin DoDot:1
+16 ; Quit if 'abbreviated' mode and this was answered previously
if $GET(DGABB)&($PIECE($GET(^DPT(DFN,2)),U,1)=1)
QUIT
+17 NEW DGOLDEN
SET DGOLDEN=$PIECE($GET(^DPT(DFN,2)),"^")
+18 NEW DIE,DA
SET DIE="^DPT("
SET DA=DFN
SET DR="537027////1;537030////"_DGMHVNOW
DO ^DIE
+19 if DGOLDEN=DGMHV("ENROLLED")
QUIT
+20 NEW DGFLD
FOR DGFLD=537033,537036
DO FILRNA(DFN,DGFLD,"@")
+21 ; If "Registered:" changed from NO or Action to YES, remove NO values in AUTHENTICATED and SECURE MESSAGING
+22 NEW MHVND
SET MHVND=$GET(^DPT(+DFN,2))
+23 IF $PIECE(MHVND,"^",2)=0
FOR DGFLD=537028,537031,537034,537037
DO FILRNA(DFN,DGFLD,"@")
+24 IF $PIECE(MHVND,"^",3)=0
FOR DGFLD=537029,537032,537035,537038
DO FILRNA(DFN,DGFLD,"@")
End DoDot:1
+25 QUIT
+26 ;
AUTHENT ; Authenticated MHV account status
+1 DO AUTHENQ(.DGMHV,.DGMHVNOW)
IF $DATA(DIRUT)
SET DGMHVOUT=1
SET DGMHVQ=1
QUIT
+2 if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+3 IF '$GET(DGMHV("AUTH"))
SET DGRNSPT=""
SET DGRSNTXT=""
DO CANTXT^DGMHVUTL("UP",1,1)
Begin DoDot:1
+4 WRITE !!,"Patient Not Authenticated Reasons"
+5 NEW DGADFLT,UTILITY,DIC,DA,DR
SET DIC=2
SET DA=DFN
SET DR="537037"
DO GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
+6 SET DGADFLT=$GET(UTILITY(2,DFN_",",537037,"I"))
+7 DO GETRSN("patient has not upgraded/authenticated",.DGRSNPT,.DGRSNTXT,DGADFLT,2.2)
if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+8 IF $DATA(DIRUT)!$GET(DGMHVOUT)
SET DGMHVQ=1
SET DGMHVOUT=1
QUIT
+9 FOR DGRPFLD=537034,537035
DO FILRNA(DFN,DGRPFLD,"@")
+10 FOR DGRPFLD=537037,537038
DO FILRNA(DFN,DGRPFLD,DGRSNPT)
+11 IF $PIECE($GET(^DGMHV(390.03,DGRSNPT,0)),"^")="Other"
FOR DGRTFLD=537034:1:537035
DO FILRNA(DFN,DGRTFLD,DGRSNTXT)
+12 NEW DIE,DR,DA
SET DA=DFN
+13 SET DIE="^DPT("
SET DR="537028////"_DGMHV("AUTH")_";537031////"_DGMHVNOW_";537029////0;537032////"_DGMHVNOW
+14 DO ^DIE
+15 DO FILACT(DFN,3)
DO FILACT(DFN,4)
End DoDot:1
if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+16 IF $GET(DGMHV("AUTH"))=1
Begin DoDot:1
+17 NEW DGOLDAU
SET DGOLDAU=$PIECE($GET(^DPT(DFN,2)),"^",2)
+18 NEW DIE,DA
SET DIE="^DPT("
SET DA=DFN
SET DR="537028////1;537031////"_DGMHVNOW
DO ^DIE
+19 ; User accepted default, nothing changed
if DGOLDAU=DGMHV("AUTH")
QUIT
+20 ;iF AUTHENTICATED is changed to YES then delete all Decline Text / Reason and Action
+21 FOR DGFLD=537034,537037
DO FILRNA(DFN,DGFLD,"@")
+22 DO FILACT(DFN,4)
+23 ;iF AUTHENTICATED is changed to YES then delete all SECURE MESSAGE elements
+24 FOR DGFLD=537029,537032,537035,537038
DO FILRNA(DFN,DGFLD,"@")
+25 DO FILACT(DFN,3)
End DoDot:1
+26 ; Action entered instead of yes or no
IF $GET(DGMHV("AUTH"))=2
DO CANTXT^DGMHVUTL("UP",,1)
Begin DoDot:1
+27 NEW DGOLDAU
SET DGOLDAU=$PIECE($GET(^DPT(DFN,2)),"^",2)
+28 WRITE !!
NEW DGDPTSOC,DGMHSEL
SET DGDPTSOC=+$ORDER(^DPT(DFN,1,"A"),-1)+1
DO ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"A")
+29 NEW DGCURSEL
SET DGCURSEL=$ORDER(DGMHSEL(0))
IF 'DGCURSEL
QUIT
+30 NEW DIE,DA
SET DIE="^DPT("
SET DA=DFN
SET DR="537028////2;537031////"_DGMHVNOW
DO ^DIE
+31 DO FILRNA(DFN,537034,"@")
DO FILRNA(DFN,537037,"@")
+32 DO FILACT(DFN,4,.DGMHSEL)
+33 if DGOLDAU=DGMHV("AUTH")
QUIT
+34 ;iF AUTHENTICATED is changed to ACTION then delete all SECURE MESSAGE elements
+35 FOR DGFLD=537029,537032,537035,537038
DO FILRNA(DFN,DGFLD,"@")
+36 DO FILACT(DFN,3)
End DoDot:1
SET DGMHVQ=1
QUIT
+37 WRITE !
+38 QUIT
+39 ;
SECMSG ; Secure Messaging
+1 KILL DIRUT
DO OPTINQ(.DGMHV,.DGMHVNOW)
IF $DATA(DIRUT)
SET DGMHVOUT=1
SET DGMHVQ=1
+2 if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+3 IF '$GET(DGMHV("OPTINQ"))
SET DGRNSPT=""
SET DGRSNTXT=""
Begin DoDot:1
+4 NEW DGMDFLT,UTILITY,DIC,DA,DR
SET DIC=2
SET DA=DFN
SET DR="537038"
DO GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
+5 SET DGMDFLT=$GET(UTILITY(2,DFN_",",537038,"I"))
+6 DO GETRSN("not using secure messaging",.DGRSNPT,.DGRSNTXT,DGMDFLT,2.3)
if $GET(DGMHVOUT)!$GET(DGMHVQ)
QUIT
+7 IF $DATA(DIRUT)!$GET(DGMHVOUT)
SET DGMHVQ=1
SET DGMHVOUT=1
QUIT
+8 DO FILRNA(DFN,537035,"@")
+9 NEW DIE,DR,DA
SET DA=DFN
SET DIE="^DPT("
SET DR="537029////"_DGMHV("OPTINQ")_";537032////"_DGMHVNOW
DO ^DIE
+10 DO FILRNA(DFN,537038,DGRSNPT)
+11 IF $PIECE($GET(^DGMHV(390.03,DGRSNPT,0)),"^")="Other"
DO FILRNA(DFN,537035,DGRSNTXT)
+12 DO FILACT(DFN,3)
End DoDot:1
if $GET(DGMHVOUT)
QUIT
+13 IF $GET(DGMHV("OPTINQ"))=1
Begin DoDot:1
+14 NEW DIE,DA
SET DIE="^DPT("
SET DA=DFN
SET DR="537029////1;537032////"_DGMHVNOW
DO ^DIE
+15 DO FILRNA(DFN,537035,"@")
DO FILRNA(DFN,537038,"@")
+16 DO FILACT(DFN,3)
End DoDot:1
QUIT
+17 IF $GET(DGMHV("OPTINQ"))=2
Begin DoDot:1
+18 NEW DGOLDMSG
SET DGOLDMSG=$$GETMSG^DGMHVUTL(DFN)
+19 WRITE !!
NEW DGDPTSOC,DGMHSEL
SET DGDPTSOC=+$ORDER(^DPT(DFN,1,"A"),-1)+1
DO ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"M")
+20 NEW DGCURSEL
SET DGCURSEL=$ORDER(DGMHSEL(0))
IF 'DGCURSEL
Begin DoDot:2
End DoDot:2
QUIT
+21 NEW DIE,DA
SET DIE="^DPT("
SET DA=DFN
SET DR="537029////2;537032////"_DGMHVNOW
DO ^DIE
+22 DO FILRNA(DFN,537035,"@")
DO FILRNA(DFN,537038,"@")
+23 DO FILACT(DFN,3,.DGMHSEL)
End DoDot:1
QUIT
+24 QUIT
+25 ;
GETRSN(TXTAD,REASPT,REASTXT,REASDFLT,DGTXTND) ; Prompt for "NO" Reason
+1 NEW DGDFTXT,DGMSACT,DIR,X,Y
KILL DIRUT,DGTXTFIN,DGSCR
+2 SET DGSCR=$SELECT($GET(DGTXTND)=2.1:1,$GET(DGTXTND)=2.2:2,$GET(DGTXTND)=2.3:3,1:"")
+3 SET DGDFTXT=$$LKUPRTXT^DGMHVAC(DFN,$GET(DGTXTND))
SET DGTXTFIN=0
+4 DO GETRSNS(.DGMSACT,DGSCR)
+5 IF $GET(REASDFLT)
NEW RSNSEL
SET RSNSEL=""
FOR
SET RSNSEL=$ORDER(DGMSACT(RSNSEL))
if 'RSNSEL
QUIT
IF $GET(DGMSACT(RSNSEL,"IEN"))=REASDFLT
SET REASDFLT=RSNSEL
+6 DO SETDIR(.DGMSACT,TXTAD,$GET(REASDFLT))
+7 SET REASPT=""
FOR
if $GET(REASPT)!$GET(DGMHVOUT)
QUIT
DO ^DIR
if (Y>0)
SET REASPT=+$GET(DGMSACT(Y,"IEN"))
IF 'REASPT
Begin DoDot:1
+8 NEW DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to quit "
DO ^DIR
IF $GET(Y)>0
SET DGMHVOUT=1
+9 NEW UTILITY,DIC,DA,DR
SET DIC=2
SET DA=DFN
SET DR="537038"
DO GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
+10 SET DGMDFLT=$GET(UTILITY(2,DFN_",",537038,"I"))
End DoDot:1
+11 if '$GET(REASPT)
QUIT
+12 IF $PIECE($GET(^DGMHV(390.03,REASPT,0)),"^")="Other"
FOR
if $GET(DGTXTFIN)!$GET(DGMHVQ)
QUIT
Begin DoDot:1
+13 NEW DIR,X,Y
SET DIR("B")=$GET(DGDFTXT)
SET DIR(0)="FAR^2:250"
SET DIR("A")="Other Reason Text (250 Chars Max): "
DO ^DIR
+14 IF $LENGTH(Y)>1
SET REASTXT=$TRANSLATE(Y,";^"," ")
SET DGTXTFIN=1
QUIT
+15 IF $GET(X)="@"
SET DGDFTXT=""
WRITE " Deleted",!
+16 IF $GET(X)="^"
SET DGMHVQ=1
QUIT
End DoDot:1
+17 QUIT
+18 ;
FILRNA(DFN,DGFIELD,DGRSPT) ; File selected NO Reason to Patient file
+1 NEW DIE,DA,DR
+2 SET DIE="^DPT("
SET DA=DFN
SET DR=DGFIELD_"////"_DGRSPT
DO ^DIE
+3 QUIT
+4 ;
FILACT(DFN,DGNODE,DGACTSEL) ; File selected MHV Action(s) to Patient file
+1 NEW NEXT,DGCNT
+2 SET NEXT="A"
FOR
SET NEXT=$ORDER(^DPT(DFN,DGNODE,NEXT),-1)
if 'NEXT
QUIT
Begin DoDot:1
+3 NEW DIE,DA,DIR
SET DIE="^DPT("_DFN_","_DGNODE_","
SET DA(1)=DFN
SET DA=NEXT
SET DR=.01_"////@"
DO ^DIE
End DoDot:1
+4 SET NEXT=0
FOR DGCNT=1:1
SET NEXT=$ORDER(DGACTSEL(NEXT))
if 'NEXT
QUIT
Begin DoDot:1
+5 if '$GET(DGACTSEL(NEXT,"IEN"))
QUIT
+6 NEW DA,DINUM,X,DIC
SET DIC(0)="LEZ"
SET DIC="^DPT(DFN,DGNODE,"
SET DA(1)=DFN
SET DA=DGCNT
SET DINUM=DA
SET X=DGACTSEL(NEXT,"IEN")
DO FILE^DICN
End DoDot:1
+7 QUIT
+8 ;
GETRSNS(DGMSACT,DGSCRQ) ; Build and return array of selectable reasons from file 390.03
+1 NEW ACTIEN,ACTCNT,ACTTXT,SELCNT,DGSCR
SET ACTCNT=0
SET SELCNT=0
+2 SET ACTIEN=0
FOR
SET ACTIEN=$ORDER(^DGMHV(390.03,ACTIEN))
if 'ACTIEN
QUIT
SET ACTTXT=$PIECE($GET(^DGMHV(390.03,ACTIEN,0)),"^")
SET DGSCR=$PIECE(^(0),"^",2)
IF ACTTXT]""
Begin DoDot:1
+3 IF $GET(DGSCRQ)
IF $GET(DGSCR)
if DGSCR'[DGSCRQ
QUIT
+4 SET ACTCNT=ACTCNT+1
SET SELCNT=SELCNT+1
SET DGMSACT(ACTCNT)=ACTTXT
SET DGMSACT(ACTCNT,"IEN")=ACTIEN
End DoDot:1
+5 QUIT
+6 ;
SETDIR(DGMSACT,TXTAD,DGMDEF) ; Put incoming array of reasons into DIC("A")
+1 SET DIR(0)="SA^"
SET DIR("A",1)=""
SET DIR("B")=$GET(DGMDEF)
+2 SET ACTCNT=0
FOR
SET ACTCNT=$ORDER(DGMSACT(ACTCNT))
if 'ACTCNT
QUIT
SET DIR(0)=DIR(0)_ACTCNT_":"_DGMSACT(ACTCNT)_";"
SET DIR("A",ACTCNT+1)=" "_ACTCNT_" - "_DGMSACT(ACTCNT)
+3 SET DIR("A",$ORDER(DIR("A","A"),-1)+1)=""
+4 NEW LINE,II,MARX,TXL
DO TXT^DGMHV(TXTAD,30)
+5 IF $ORDER(MARX(""),-1)=1
SET DIR("A")="Select reason "_TXTAD_": "
QUIT
+6 SET TXL=0
FOR II=1:1
SET TXL=$ORDER(MARX(TXL))
if 'TXL
QUIT
Begin DoDot:1
+7 SET LINE=$SELECT(II=1:"Select reason ",1:"")_MARX(TXL)
+8 IF $ORDER(MARX(TXL))=""
SET DIR("A")=LINE
QUIT
+9 SET DIR("A",$ORDER(DIR("A","A"),-1)+1)=""
End DoDot:1
+10 SET DIR("A")="Select reason "_TXTAD_": "
+11 QUIT
+12 ;
MHVOK(DFN) ; Check patient's MHV enrollment/registration info.
+1 ; Logic to activate/deactivate alert
+2 ; -----------------------------------
+3 ; 1. If any field contains null (UNANSWERED), return 0
+4 ; 2. If any field contains "A" (ACTION), return 0
+5 ; 3. If neither 1 nor 2 is true, and any field contains "N" (NO):
+6 ; a. The alert is ON if the date the NO was entered is at least 6 months prior to the current date
+7 ; b. The alert is OFF if the date the NO was entered is less than 6 months prior to the current date
+8 ; 4. If all fields contain "Y" (YES), return 1
+9 ;
+10 NEW DIR,DGIQ,MHVOK,MHVOKND,MHVEN,MHVBAD,UTILITY
+11 NEW DIC,DA,DR
SET DIC=2
SET DA=DFN
SET DR="537027:537032"
DO GETS^DIQ(DIC,DFN,DR,"I","UTILITY")
+12 MERGE MHVOK(DFN)=UTILITY(2,DFN_",")
+13 SET MHVBAD=0
+14 FOR DGIQ=0:1:2
IF $GET(MHVOK(DFN,537027+DGIQ,"I"))=""
SET MHVBAD=1
+15 IF $GET(MHVBAD)
QUIT 0
+16 FOR DGIQ=0:1:2
if $GET(MHVBAD)
QUIT
Begin DoDot:1
+17 IF $GET(MHVOK(DFN,537027+DGIQ,"I"))=0
Begin DoDot:2
+18 IF '$GET(MHVOK(DFN,537030+DGIQ,"I"))
SET MHVBAD=1
QUIT
+19 IF $$FMDIFF^XLFDT($$NOW^XLFDT,MHVOK(DFN,537030+DGIQ,"I"))>179
SET MHVBAD=1
Begin DoDot:3
+20 NEW DGQ
FOR DGQ=537027+DGIQ:1:537029
if DGQ>537029
QUIT
DO FILRNA(DFN,DGQ,"@")
End DoDot:3
End DoDot:2
QUIT
+21 IF (MHVOK(DFN,537027+DGIQ,"I")="")!(MHVOK(DFN,537027+DGIQ,"I")=2)
SET MHVBAD=1
End DoDot:1
+22 QUIT $SELECT($GET(MHVBAD):0,1:1)
+23 ;
LKUPRSN(REASON) ; Lookup "NO" Reason in file 390.03
+1 NEW DIC,X
SET DIC="390.03"
SET DIC(0)="ZU"
SET X=+REASON
DO ^DIC
+2 QUIT $PIECE($GET(Y(0)),"^")
+3 ;
LKUPRTXT(DFN,DGRFIELD) ; Lookup "OTHER" Reason free text from PATIENT (#2) file
+1 SET DGRSNTXT=$PIECE($GET(^DPT(+DFN,+DGRFIELD)),"^")
+2 QUIT $SELECT($LENGTH(DGRSNTXT)>1:DGRSNTXT,1:"")
+3 ;
LKUPACT(ACTION) ; Lookup MHV Action in file 390.02
+1 NEW DIC,X
SET DIC="390.02"
SET DIC(0)="ZU"
SET X=+ACTION
DO ^DIC
+2 QUIT $GET(Y(0))
+3 QUIT
+4 ;
LASTACHK(DFN,ACTXT) ; Check if ACTXT contains the text matching the most recent ACTION entered for patient DFN
+1 NEW DGMATCH,DGLST5,DGLST1,DGL1TXT
SET DGMATCH=0
SET DGLST5=""
+2 DO GETLACT^DGMHVUTL(DFN,.DGLST5)
SET DGLST1=$ORDER(DGLST5($$NOW^XLFDT),-1)
+3 IF $GET(DGLST1)
Begin DoDot:1
+4 SET DGL1TXT=$GET(DGLST5(DGLST1,1,"TXT",1))
+5 IF $EXTRACT($GET(ACTXT),1,$LENGTH($GET(DGL1TXT)))=$EXTRACT($GET(DGL1TXT),1,$LENGTH($GET(DGL1TXT)))
SET DGMATCH=1
End DoDot:1
+6 QUIT $SELECT($GET(DGMATCH):1,1:0)
