DGMHV ;ALB/JCH - Display Pre-Registration MHV Enrollment/Registration ; 12/9/03 3:22pm
;;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
;
Q
EN(DFN) ; Entry Point for Alert, Socialization, and MHV Enrollment/Registration field editing 'Screen'
;This functionality will only be executed if "Enable MyHealtheVet Prompts?" (#1100.07
;field in MAS PARAMETERS (43) file is set to YES (internal value 1)
D:$$MHVENABL^DGMHVUTL() MAIN^DGMHV(DFN)
Q
MAIN(DFN) ; Main Entry Point for MHV socialization text/action
; Do not display MHV enrollment/registration 'screen' if socialization Action entered
; (DGMHVOUT="A"), meaning MHV enrollment/registration is in progress, not a firm YES or NO
; Do not display socialization text/action if MHV ENROLLED/REGISTERED field is not null (DGMHVOUT="R")
N DGMHVNOS,DGRSPNS,DGENTRY,DGACTS,DGMHAC,DGMHSEL,DGDPTSOC,DGMHVOUT,DGMHVNOS,DIR
D CLEAR,ALERT,DSPLACT(DFN) I $G(DGMHVOUT)="" W !!! D CONT
D CLEAR
I $G(DGMHVOUT)="R" D EN^DGMHVAC(DFN) Q
I $G(DGMHVOUT)="A" D Q
.N DGDPTSOC S DGDPTSOC=+$O(^DPT(DFN,1,"A"),-1)+1 D ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"S")
.Q:$G(DGMHVOUT)!$G(DGMHVNOS)
.D EN^DGMHVAC(DFN)
D SOCIAL^DGMHV Q:$G(DGMHVOUT)
Q:$G(DGMHVNOS)
D EN^DGMHVAC(DFN)
Q
SOCIAL ; MHV Enrollment/Registration talking point/socialization text action
; Display MHV socialization canned text, prompt for patient response, display and prompt for clerk action
I $P($G(^DPT(DFN,2)),"^") Q
N DGSODONE
F Q:$G(DGSODONE)!$G(DGMHVOUT) D SLOOP
Q
SLOOP ; Allow user to go back and enter a different patient response in case the patient changes their mind
N DGMHV,I,DGDIR0,DGDPTSOC,DGTAB,DGREADTX,DGMHVMOD S DGDPTSOC="",DGMHVMOD="S"
K DIRUT
S DGREADTX="Please read the following to the patient"
D GTSOCODS(.DGDIR0) S DGDIR0="SO^",I="" F S I=$O(DGDIR0(I)) Q:'I S DGDIR0=DGDIR0_I_":"_DGDIR0(I)_";"
F Q:$G(DGMHVOUT)!$G(DGMHV("SOCIAL")) D
.D CLEAR W !!,DGREADTX
.K DIR W !!?8,"""Has a health care team member encouraged you"
.W !?9,"to register online for My HealtheVet?"""
.S DIR("A")="Patient response"
.S DIR(0)=DGDIR0
.S DIR("??")="D CLEAR" D ^DIR I $E($G(Y))="^" S DGMHVOUT=1 Q
.I Y="" W !!,"My HealtheVet registration information is required to continue with this patient",!! D CONT Q
.S DGMHV("SOCIAL")=$G(DGDIR0(Y,"IEN"))
Q:$G(DGMHVOUT)
D FILSOC(DFN,+DGMHV("SOCIAL"),$$NOW^XLFDT,.DGDPTSOC)
I DGMHV("SOCIAL")=1 D
.N DGOLDEN S DGOLDEN=$P($G(^DPT(DFN,2)),"^")
.N DIE,DR,DA S DIE="^DPT(",DR="537027////1;537030////"_$$NOW^XLFDT,DA=DFN D ^DIE
.Q:DGOLDEN=1
.N DGFLD F DGFLD=537033,537036 D FILRNA^DGMHVAC(DFN,DGFLD,"@")
.N MHVND S MHVND=$G(^DPT(+DFN,2))
.I $P(MHVND,"^",2)=0 F DGFLD=537028,537031,537034,537037 D FILRNA^DGMHVAC(DFN,DGFLD,"@")
.I $P(MHVND,"^",3)=0 F DGFLD=537029,537032,537035,537038 D FILRNA^DGMHVAC(DFN,DGFLD,"@")
Q:'$G(DGMHV("SOCIAL")) D CLEAR W !!,DGREADTX W !! D CANNED(DGMHV("SOCIAL")) D CONT I (DGMHV("SOCIAL")>1) I $G(DIRUT)&($G(X)="^") S DGSODONE=0 Q
N FLWUP,RTST S DGAR1=DGDPTSOC S FLWUP=$G(^DGMHV(390.01,DGMHV("SOCIAL"),4)) S RTST=$P(FLWUP,"^",2),RTST=$P(RTST,"(") I RTST]"" I $T(@RTST)]"" X FLWUP
S DGSODONE=1
Q
ALERT ; Displays the 'MHV Enrollment/Registration Information Missing' message
Q:'$D(XQY0)
N X,Y,IORVON,IORVOFF,DIR,DIRUT
S X="IORVON;IORVOFF"
D ENDR^%ZISS
W !!!!?4,$CHAR(7) W:$D(IORVON) IORVON W "** PATIENT NEEDS TO ANSWER MY HEALTHEVET REGISTRATION QUESTIONS **" W:$D(IORVOFF) IORVOFF
W !?4,"Patient is missing required My HealtheVet Registration information",!
Q
FILSOC(DFN,RSPNT,RSPDT,DGDPTSOC) ; File MHV Socialization Information to PATIENT (#2) file
; DFN = PATIENT IEN
; RSPNT = RESPONSE POINTER TO FILE 390.01
; RPSDT = RESPONSE DATE/TIME
N DINUM,DIE,DA,DR,DO,DGMHVND K DIE,DA,DR,DO
S DIC(0)="EZ",DIC="^DPT(DFN,1,",DA(2)=DFN,DA(1)=+$O(^DPT(DFN,1,"A"),-1)+1,DGDPTSOC=DA(1)
S DGMHVND=DA(1),DINUM=DA(1),X=RSPDT,DIC("DR")=".01////"_RSPDT_";1////"_RSPNT D FILE^DICN
K DIE,DIC,DA S DIE="^DPT(DFN,1,",DA(1)=DFN,DA=DGMHVND
S DR=".01////"_RSPDT_";1////"_RSPNT D ^DIE
Q
CANNED(SCRIPT) ; Display canned text from PATIENT TEXT (#2) field in the MHV SOCIALIZATION (#390.01) file
Q:'$G(SCRIPT)
N DGMHVLIN,DGLINCNT,DGMHVOUT S DGMHVLIN=$P($G(^DGMHV(390.01,SCRIPT,2,0)),"^",3),DGMHVOUT=0
S DGLINCNT=0 F S DGLINCNT=$O(^DGMHV(390.01,SCRIPT,2,DGLINCNT)) Q:'DGLINCNT!(DGLINCNT>DGMHVLIN) D
.W !?2 W:DGLINCNT=1 """" W ^DGMHV(390.01,SCRIPT,2,DGLINCNT,0) S DGMHVOUT=1
W:$G(DGMHVOUT) """" W !
Q
GTSOCODS(DGSOCCOD) ; Get array of socialization codes and display sequences from MHV SOCIALIZATION (#390.01) file
K DGSOCCOD,DGSOCIEN,DGSOCSEQ S DGSOCSEQ="",DGSOCCOD="",DGSOCIEN="" N I,TEXT S I=0,TEXT=""
F S DGSOCSEQ=$O(^DGMHV(390.01,"C",DGSOCSEQ)) Q:'DGSOCSEQ D
.S DGSOCIEN="" F S DGSOCIEN=$O(^DGMHV(390.01,"C",DGSOCSEQ,DGSOCIEN)) Q:DGSOCIEN="" D
..N TEXT D FIND^DIC(390.01,"","@;.01","A",DGSOCIEN,1,"","","","TEXT")
..S I=I+1 S DGSOCCOD(I)=TEXT("DILIST","ID",1,".01"),DGSOCCOD(I,"IEN")=DGSOCIEN
Q
NOFLW(DGSOCCOD) ; Perform followup dialog for patient that does not wish to enroll/register
N DIR,DIC,DA,DGAR1,DGAR2 S DGAR1="",DGAR2=""
W !! S DIR("A",1)=" How does the patient feel now about registering in My HealtheVet?"
S DIR("A",2)=" ",DIR("A",3)=" 1) Patient is not interested."
S DIR("A",4)=" 2) Patient is interested.",DIR("A",5)=" "
S DIR(0)="SA^1:Patient is not interested;2:Patient is interested",DIR("A")="Select a response: "
D ^DIR I $G(Y)'="1" D ACTIONS(.DGAR1,DGAR2,$G(DGDPTSOC),"S") Q
; If patient isn't interested to be enrolled/register in MHV then update Enroll/Register,
; Authenticated, and Secure Message fields to "NO"
N DIE,DR,DA,DGMHVNOW S DA=DFN,DGMHVNOW=$$NOW^XLFDT
S DIE="^DPT(",DR="537027////0;537030////"_DGMHVNOW_";537028////0;537029////0;537031////"_DGMHVNOW_";537032////"_DGMHVNOW
D ^DIE
F DGRPFLD=537036:1:537038 D FILRNA^DGMHVAC(DFN,DGRPFLD,+$O(^DGMHV(390.03,"B","I am not interested.","")))
Q
ACTIONS(DGMSACT,ACTSEL,DGENRQ,DGMHVMOD) ; Display MHV Socialization actions, allow selection, return selected actions in ACTSEL
; Input:
; DGMSACT - Array of selectable actions from MHV SOCIALIZATION ACTIONS (#390.02) file
; ACTSEL - Array of action(s) currently selected by clerk
; DGENRQ - Internal Entry Number (IEN) of the prospective MHV SOCIALIZATION (#537026) multiple in the PATIENT (#2) file into which
; the selected actions in ACTSEL will be stored.
; DGMHVMOD - Mode; the section of MHV functionality from which this is invoked. Used to screen selectable actions.
; "R" - Enrollment/Registration "S" - Socialization, "A" - Authentication field, "M" - Secure Messaging field
K DIR,DGMSACT D CLEAR
N DINUM,DIR,ACTCNT,DGACDONE,DGSTAY,DGACSAVE,DGACCNT S DGACDONE=0,DGACSAVE=0
D GETACTS(.DGMSACT,$G(DGMHVMOD)) S DGACCNT=+$O(DGMSACT(""),-1)
S DIR(0)="SA^" S ACTCNT=0 F S ACTCNT=$O(DGMSACT(ACTCNT)) Q:'ACTCNT S DIR(0)=DIR(0)_ACTCNT_":"_DGMSACT(ACTCNT)_";"
S $P(DIR(0),"^",3)="D ACTRNSFM^DGMHV"
F Q:$G(DGACDONE) D ACTLOOP(.DIR,.DGMSACT,.ACTSEL)
I $G(DGACSAVE),$D(ACTSEL)>1 D S DGMHVNOS=1 Q
.I $G(DGENRQ),'$G(DGDPTSOC) S DGDPTSOC=DGENRQ
.N DGSEL,DGAIEN,DGMHVND,DGPLURAL S DGSEL=0 F DGPLURAL=1:1 S DGSEL=$O(ACTSEL(DGSEL)) Q:'DGSEL D
..N DIE,DA,DIC S DGAIEN=$G(ACTSEL(DGSEL,"IEN")),DIC(0)="EZ",DIC="^DPT("_DFN_",1,"_DGDPTSOC_",1,",DA(3)=DFN,DA(2)=DGDPTSOC
..S DA(1)=$O(^DPT(DFN,1,DA(2),1,"A"),-1)+1,DINUM=DA(1),X=DGAIEN,DGMHVND=DA(1),DIC("DR")=".01////"_DGAIEN D FILE^DICN I $G(DGENRQ) D
...N DA,DIE,DIC,RSPDT S RSPDT=$$NOW^XLFDT S DIE="^DPT(DFN,1,",DA(1)=DFN,DA=DGENRQ S DR=".01////"_RSPDT D ^DIE
..N DA,DIE,DIC K DIE,DIC,DA S DIE="^DPT("_DFN_",1,"_DGDPTSOC_",1,",DA(2)=DFN,DA(1)=DGDPTSOC,DA=$O(^DPT(DFN,1,DGDPTSOC,1,"A"),-1)
..S DR=".01////"_DGAIEN D ^DIE
.W !,$S($G(DGPLURAL)=1:"Action",1:"Actions")," Filed...",! H .5
S DGMHVOUT=1
Q
ACTLOOP(DIR,DGMSACT,ACTSEL) ; Redisplay and reprompt user for action(s) until they're filed, or user aborts
D CLEAR
S DGSTAY=1
W !?2,"Action(s) taken today to assist patient with My HealtheVet registration."
W !?2,"-----------------------------------------------------------------------"
D ^DIR
I Y="^"!$G(DIRUT) W !! N DGREALQ S DGREALQ=1 D Q
.N DIR,Y S DIR(0)="Y",DIR("A",1)="My HealtheVet registration questions are required to continue with this patient."
.S DIR("A")="Are you sure you want to quit " D ^DIR I $G(Y) S DGMHVOUT=1,DGACDONE=1,DGACSAVE=0,DGSTAY=0 Q
.S DGSTAY=1
I $G(Y)>0 N DGSELL F DGSELL=1:1:$L(Y,",") N DGSELIT S DGSELIT=$P(Y,",",DGSELL) I DGSELIT]"" M ACTSEL(DGSELIT)=DGMSACT(DGSELIT)
F Q:'$G(DGSTAY) D
.D CLEAR N DIR,SELAC,DGCNT,DGII S DGCNT=1,DGSTAY=0
.S DIR("A",DGCNT)="",DGCNT=DGCNT+1
.S DIR("A",DGCNT)="Actions Selected:"
.S DGCNT=DGCNT+1,DIR("A",DGCNT)=" " ;"-----------------------------------------------------------------------"
.S SELAC="" F DGII=1:1 S SELAC=$O(ACTSEL(SELAC)) Q:'SELAC D
..N SELACSUB,MARX S SELACSUB=0 D TXT(ACTSEL(SELAC),65) F S SELACSUB=$O(MARX(SELACSUB)) Q:'SELACSUB D
...S DGCNT=DGCNT+1 S DIR("A",DGCNT)=" "_$S(SELACSUB=1:SELAC_" - ",1:" ")_" "_MARX(SELACSUB)
.S DGCNT=DGCNT+1 S DIR("A",DGCNT)=""
.S DIR("A")=" (A)dd another, (D)elete an action, or <RET> to save and exit: ",DIR(0)="SAO^A:Add an Action;D:Delete an Action" D ^DIR W !
.Q:Y="A"
.I Y="D" S DGSTAY=1 D DELETE(.ACTSEL) Q
.I Y="^" W !! N DGREALQ S DGREALQ=1 D Q
..N DIR,Y S DIR(0)="Y",DIR("A",1)="My HealtheVet registration information is required to continue with this patient."
..S DIR("A")="Are you sure you want to quit " D ^DIR I $G(Y) S DGMHVOUT=1,DGACDONE=1,DGACSAVE=0,DGSTAY=0 Q
..S DGSTAY=1
.S DGACDONE=1,DGACSAVE=1
Q
GETACTS(DGMSACT,DGMHVMOD) ; Get actions from the MHV SOCIALIZATION ACTIONS (#390.02) file; screen by mode (DGMHVMOD)
; Input: DGMHVMOD - Mode; MHV functionality from which this is invoked. Used to screen selectable Actions.
; DGMSACT - Array containing appropriate MHV actions, after screening based on mode (DGMHVMOD).
N ACTIEN,ACTCNT,ACTTXT,SELCNT,DGMHVSAT S ACTCNT=0,SELCNT=0
S ACTIEN=0 F S ACTIEN=$O(^DGMHV(390.02,ACTIEN)) Q:'ACTIEN S ACTTXT=$P($G(^DGMHV(390.02,ACTIEN,3,1,0)),"^") I ACTTXT]"" D
.N TXTND S TXTND=1 F S TXTND=$O(^DGMHV(390.02,ACTIEN,3,TXTND)) Q:'TXTND S ACTTXT=ACTTXT_" "_^DGMHV(390.02,ACTIEN,3,TXTND,0)
.N ACTLLIST D ACTSCRN^DGMHVUTL(ACTIEN,.ACTLLIST) I ($G(DGMHVMOD)]"") Q:'$D(ACTLLIST(DGMHVMOD))
.S ACTCNT=ACTCNT+1,SELCNT=SELCNT+1,DGMSACT(ACTCNT)=ACTTXT,DGMSACT(ACTCNT,"IEN")=ACTIEN
.N MARX,ACTLINE D TXT(ACTTXT,65) S ACTLINE=0 F S ACTLINE=$O(MARX(ACTLINE)) Q:'ACTLINE D
..N DGDASH S DGDASH=$S(ACTLINE=1&(ACTCNT<10):ACTCNT_" - ",(ACTLINE=1&(ACTCNT>9)):ACTCNT_" - ",1:" ")
..S DIR("A",SELCNT)=" "_DGDASH_" "_MARX(ACTLINE) S SELCNT=SELCNT+1
S DIR("A",SELCNT+1)=" "
S DIR("A")=" Select an action or '^' to exit: "
Q
DELETE(DGACTD) ; Delete one previously selected action
; Input : DGACTD - Array of MHV actions selected by clerk.
K DGDELDIR,DIR N DGDELAR,II,DGCNT,ZZ S DGCNT=0
M DGDELAR=DGACTD
;
K DGACTD M DGACTD=DGDELAR
S DIR(0)="SAO^" S ZZ=0 F II=1:1 S ZZ=$O(DGDELAR(ZZ)) Q:'ZZ S DIR(0)=DIR(0)_ZZ_":"_DGDELAR(ZZ)_";"
S DIR("A")="Select an action to delete: " D ^DIR I $G(Y)>0,$D(DGACTD(+Y)) K DGACTD(Y)
W ! D CONT I '$D(DGACTD) S DGSTAY=0 D CLEAR
Q
REVERSE(PAD,DGREVTXT) ; Display DGREVTXT in reverse video
N X,Y,IORVON,IORVOFF,DIR,DIRUT
S X="IORVON;IORVOFF" S PAD=+$G(PAD)
D ENDR^%ZISS
W $CHAR(7) W ?PAD W:$D(IORVON) IORVON W DGREVTXT W:$D(IORVOFF) IORVOFF
Q
TXT(TXT,LEN) ; Split string into multiple LEN length lines
;* Input: TXT = TXT string
;* LEN = format length
;* Output: MARX array.
N OLD,X1,Y D SPLIT K MARX
S X=0,X1=1,Y="" F S X=$O(OLD(X)) Q:'X D
. I $L(Y_OLD(X))>LEN S MARX(X1)=Y,X1=X1+1,Y="" D
.. I $E(MARX(X1-1),$L(MARX(X1-1)))'=" " Q
.. S MARX(X1-1)=$E(MARX(X1-1),1,$L(MARX(X1-1))-1)
. S Y=Y_OLD(X)
S:Y]"" MARX(X1)=Y
S MARX=X1
Q
SPLIT ; * Split a word string into individual words.
;* Input: TXT - Line of text
;* Input: LEN - Maximum length one line of text will be limited to
;* Output: OLD(X)
N BSD,NEWSTR,X,X1,Y
S OLD(1)=TXT Q:$L(TXT)<LEN
F BSD=" ","/","-" S:'$O(OLD(0)) OLD(1)=TXT D:TXT[BSD DELIM(BSD)
I '$O(OLD(1)),($L(TXT)>LEN) D LEN(1,TXT) K OLD D
. F X=0:0 S X=$O(NEWSTR(X)) Q:'X S OLD(X)=NEWSTR(X)
Q
LEN(X1,OLD) ;* Wrap word to next line if it doesn't fit the display length
N X
Q:$L(OLD)'>LEN
S X=$E(OLD,1,($L(OLD)-1)) I X["/"!(X["-") Q
I $L(OLD)>LEN F X=1:1 S NEWSTR(X1)=$E(OLD,((LEN*X)-LEN+1),(LEN*X)),X1=X1+1 Q:($L(OLD)'>(LEN*X))
Q
DELIM(BSD) ; Split a string into individual words
; Input: BSD - Characters considered delimiters between words (i.e., for identifying/splitting-up-and/or-separating words)
; Input: OLD(n) - Text array containing
; Output: OLD(n) - Array containing pdated
K NEWSTR
S X=0,X1=0 F S X=$O(OLD(X)) Q:'X F Y=1:1:$L(OLD(X),BSD) D
. S X1=X1+1
. S NEWSTR(X1)=$P(OLD(X),BSD,Y)
. I $L(OLD(X),BSD)>1,(Y<$L(OLD(X),BSD)) S NEWSTR(X1)=NEWSTR(X1)_BSD
. D LEN(.X1,NEWSTR(X1))
K OLD F X=0:0 S X=$O(NEWSTR(X)) Q:'X S OLD(X)=NEWSTR(X)
Q
CLEAR ; Clear the display
D CLEAR^VALM1
D FULL^VALM1
S VALMBCK="R"
Q
CONT ; Prompt to Continue
N DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
Q
ACTRNSFM ; Transform action prompt input
Q
DSPLACT(DFN) ; Display all MHV actions associated with last 5 date/time stamps. If last action is one of the
; MHV Socialization actions, ask additional question about whether the patient was successfully enrolled/registered
N TMPDT,LASTDT,DGACTDT,NXT1,NXT2,I,J,DGLACTS,DIC,DA,DGFLDAR S DGLACTS=""
D GETLACT^DGMHVUTL(DFN,.DGLACTS)
W !," Recent My HealtheVet actions taken by VistA Clerks "
W !,"--------------------------------------------------------------------"
D GETFLDS^DGMHVUTL(DFN,.DGFLDAR) I $O(DGFLDAR(0)) M DGLACTS=DGFLDAR
I '$O(DGLACTS(0)) W !?8," - NONE - ",!! Q
S LASTDT="" F S LASTDT=$O(DGLACTS(LASTDT)) Q:'LASTDT D
.S DGACTDT=$$FMTE^XLFDT($P(LASTDT,"."),2) I ($L(DGACTDT)<8) D
..N NEWDT,IDT,DTPC F IDT=1:1:$L(DGACTDT,"/") D
...S DTPC=$P(DGACTDT,"/",IDT),DTPC=$TR($J(DTPC,2)," ",0),NEWDT=$G(NEWDT)_$S(IDT=1:"",1:"/")_DTPC
..I NEWDT?2N1"/"2N1"/"2N S DGACTDT=NEWDT
.S NXT1=0 F I=1:1 S NXT1=$O(DGLACTS(LASTDT,NXT1)) Q:'NXT1 D
..S NXT2="" F J=1:1 S NXT2=$O(DGLACTS(LASTDT,NXT1,"TXT",NXT2)) Q:'NXT2 W ! D
...N DGSP S DGSP=$S($L($G(DGLACTS(LASTDT,NXT1,"IEN")))>1:" ",1:" ")
...W $S($G(TMPDT)'=LASTDT:DGACTDT,1:" ") W $S((J=1):DGSP_" ",1:" "),$G(DGLACTS(LASTDT,NXT1,"TXT",NXT2))
...S TMPDT=LASTDT
D QUESUC^DGMHVUTL(DFN,.DGMHVOUT) Q:($G(DGMHVOUT)]"")
Q
ACTHLP ; Help at action prompt
W !?5,"Please select one of the listed actions that most closely describes"
W !?5,"the actions taken today to help this patient register in My HealtheVet."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMHV 15063 printed Sep 23, 2025@20:20:07 Page 2
DGMHV ;ALB/JCH - Display Pre-Registration MHV Enrollment/Registration ; 12/9/03 3:22pm
+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 QUIT
EN(DFN) ; Entry Point for Alert, Socialization, and MHV Enrollment/Registration field editing 'Screen'
+1 ;This functionality will only be executed if "Enable MyHealtheVet Prompts?" (#1100.07
+2 ;field in MAS PARAMETERS (43) file is set to YES (internal value 1)
+3 if $$MHVENABL^DGMHVUTL()
DO MAIN^DGMHV(DFN)
+4 QUIT
MAIN(DFN) ; Main Entry Point for MHV socialization text/action
+1 ; Do not display MHV enrollment/registration 'screen' if socialization Action entered
+2 ; (DGMHVOUT="A"), meaning MHV enrollment/registration is in progress, not a firm YES or NO
+3 ; Do not display socialization text/action if MHV ENROLLED/REGISTERED field is not null (DGMHVOUT="R")
+4 NEW DGMHVNOS,DGRSPNS,DGENTRY,DGACTS,DGMHAC,DGMHSEL,DGDPTSOC,DGMHVOUT,DGMHVNOS,DIR
+5 DO CLEAR
DO ALERT
DO DSPLACT(DFN)
IF $GET(DGMHVOUT)=""
WRITE !!!
DO CONT
+6 DO CLEAR
+7 IF $GET(DGMHVOUT)="R"
DO EN^DGMHVAC(DFN)
QUIT
+8 IF $GET(DGMHVOUT)="A"
Begin DoDot:1
+9 NEW DGDPTSOC
SET DGDPTSOC=+$ORDER(^DPT(DFN,1,"A"),-1)+1
DO ACTIONS^DGMHV(.DGMHAC,.DGMHSEL,DGDPTSOC,"S")
+10 if $GET(DGMHVOUT)!$GET(DGMHVNOS)
QUIT
+11 DO EN^DGMHVAC(DFN)
End DoDot:1
QUIT
+12 DO SOCIAL^DGMHV
if $GET(DGMHVOUT)
QUIT
+13 if $GET(DGMHVNOS)
QUIT
+14 DO EN^DGMHVAC(DFN)
+15 QUIT
SOCIAL ; MHV Enrollment/Registration talking point/socialization text action
+1 ; Display MHV socialization canned text, prompt for patient response, display and prompt for clerk action
+2 IF $PIECE($GET(^DPT(DFN,2)),"^")
QUIT
+3 NEW DGSODONE
+4 FOR
if $GET(DGSODONE)!$GET(DGMHVOUT)
QUIT
DO SLOOP
+5 QUIT
SLOOP ; Allow user to go back and enter a different patient response in case the patient changes their mind
+1 NEW DGMHV,I,DGDIR0,DGDPTSOC,DGTAB,DGREADTX,DGMHVMOD
SET DGDPTSOC=""
SET DGMHVMOD="S"
+2 KILL DIRUT
+3 SET DGREADTX="Please read the following to the patient"
+4 DO GTSOCODS(.DGDIR0)
SET DGDIR0="SO^"
SET I=""
FOR
SET I=$ORDER(DGDIR0(I))
if 'I
QUIT
SET DGDIR0=DGDIR0_I_":"_DGDIR0(I)_";"
+5 FOR
if $GET(DGMHVOUT)!$GET(DGMHV("SOCIAL"))
QUIT
Begin DoDot:1
+6 DO CLEAR
WRITE !!,DGREADTX
+7 KILL DIR
WRITE !!?8,"""Has a health care team member encouraged you"
+8 WRITE !?9,"to register online for My HealtheVet?"""
+9 SET DIR("A")="Patient response"
+10 SET DIR(0)=DGDIR0
+11 SET DIR("??")="D CLEAR"
DO ^DIR
IF $EXTRACT($GET(Y))="^"
SET DGMHVOUT=1
QUIT
+12 IF Y=""
WRITE !!,"My HealtheVet registration information is required to continue with this patient",!!
DO CONT
QUIT
+13 SET DGMHV("SOCIAL")=$GET(DGDIR0(Y,"IEN"))
End DoDot:1
+14 if $GET(DGMHVOUT)
QUIT
+15 DO FILSOC(DFN,+DGMHV("SOCIAL"),$$NOW^XLFDT,.DGDPTSOC)
+16 IF DGMHV("SOCIAL")=1
Begin DoDot:1
+17 NEW DGOLDEN
SET DGOLDEN=$PIECE($GET(^DPT(DFN,2)),"^")
+18 NEW DIE,DR,DA
SET DIE="^DPT("
SET DR="537027////1;537030////"_$$NOW^XLFDT
SET DA=DFN
DO ^DIE
+19 if DGOLDEN=1
QUIT
+20 NEW DGFLD
FOR DGFLD=537033,537036
DO FILRNA^DGMHVAC(DFN,DGFLD,"@")
+21 NEW MHVND
SET MHVND=$GET(^DPT(+DFN,2))
+22 IF $PIECE(MHVND,"^",2)=0
FOR DGFLD=537028,537031,537034,537037
DO FILRNA^DGMHVAC(DFN,DGFLD,"@")
+23 IF $PIECE(MHVND,"^",3)=0
FOR DGFLD=537029,537032,537035,537038
DO FILRNA^DGMHVAC(DFN,DGFLD,"@")
End DoDot:1
+24 if '$GET(DGMHV("SOCIAL"))
QUIT
DO CLEAR
WRITE !!,DGREADTX
WRITE !!
DO CANNED(DGMHV("SOCIAL"))
DO CONT
IF (DGMHV("SOCIAL")>1)
IF $GET(DIRUT)&($GET(X)="^")
SET DGSODONE=0
QUIT
+25 NEW FLWUP,RTST
SET DGAR1=DGDPTSOC
SET FLWUP=$GET(^DGMHV(390.01,DGMHV("SOCIAL"),4))
SET RTST=$PIECE(FLWUP,"^",2)
SET RTST=$PIECE(RTST,"(")
IF RTST]""
IF $TEXT(@RTST)]""
XECUTE FLWUP
+26 SET DGSODONE=1
+27 QUIT
ALERT ; Displays the 'MHV Enrollment/Registration Information Missing' message
+1 if '$DATA(XQY0)
QUIT
+2 NEW X,Y,IORVON,IORVOFF,DIR,DIRUT
+3 SET X="IORVON;IORVOFF"
+4 DO ENDR^%ZISS
+5 WRITE !!!!?4,$CHAR(7)
if $DATA(IORVON)
WRITE IORVON
WRITE "** PATIENT NEEDS TO ANSWER MY HEALTHEVET REGISTRATION QUESTIONS **"
if $DATA(IORVOFF)
WRITE IORVOFF
+6 WRITE !?4,"Patient is missing required My HealtheVet Registration information",!
+7 QUIT
FILSOC(DFN,RSPNT,RSPDT,DGDPTSOC) ; File MHV Socialization Information to PATIENT (#2) file
+1 ; DFN = PATIENT IEN
+2 ; RSPNT = RESPONSE POINTER TO FILE 390.01
+3 ; RPSDT = RESPONSE DATE/TIME
+4 NEW DINUM,DIE,DA,DR,DO,DGMHVND
KILL DIE,DA,DR,DO
+5 SET DIC(0)="EZ"
SET DIC="^DPT(DFN,1,"
SET DA(2)=DFN
SET DA(1)=+$ORDER(^DPT(DFN,1,"A"),-1)+1
SET DGDPTSOC=DA(1)
+6 SET DGMHVND=DA(1)
SET DINUM=DA(1)
SET X=RSPDT
SET DIC("DR")=".01////"_RSPDT_";1////"_RSPNT
DO FILE^DICN
+7 KILL DIE,DIC,DA
SET DIE="^DPT(DFN,1,"
SET DA(1)=DFN
SET DA=DGMHVND
+8 SET DR=".01////"_RSPDT_";1////"_RSPNT
DO ^DIE
+9 QUIT
CANNED(SCRIPT) ; Display canned text from PATIENT TEXT (#2) field in the MHV SOCIALIZATION (#390.01) file
+1 if '$GET(SCRIPT)
QUIT
+2 NEW DGMHVLIN,DGLINCNT,DGMHVOUT
SET DGMHVLIN=$PIECE($GET(^DGMHV(390.01,SCRIPT,2,0)),"^",3)
SET DGMHVOUT=0
+3 SET DGLINCNT=0
FOR
SET DGLINCNT=$ORDER(^DGMHV(390.01,SCRIPT,2,DGLINCNT))
if 'DGLINCNT!(DGLINCNT>DGMHVLIN)
QUIT
Begin DoDot:1
+4 WRITE !?2
if DGLINCNT=1
WRITE """"
WRITE ^DGMHV(390.01,SCRIPT,2,DGLINCNT,0)
SET DGMHVOUT=1
End DoDot:1
+5 if $GET(DGMHVOUT)
WRITE """"
WRITE !
+6 QUIT
GTSOCODS(DGSOCCOD) ; Get array of socialization codes and display sequences from MHV SOCIALIZATION (#390.01) file
+1 KILL DGSOCCOD,DGSOCIEN,DGSOCSEQ
SET DGSOCSEQ=""
SET DGSOCCOD=""
SET DGSOCIEN=""
NEW I,TEXT
SET I=0
SET TEXT=""
+2 FOR
SET DGSOCSEQ=$ORDER(^DGMHV(390.01,"C",DGSOCSEQ))
if 'DGSOCSEQ
QUIT
Begin DoDot:1
+3 SET DGSOCIEN=""
FOR
SET DGSOCIEN=$ORDER(^DGMHV(390.01,"C",DGSOCSEQ,DGSOCIEN))
if DGSOCIEN=""
QUIT
Begin DoDot:2
+4 NEW TEXT
DO FIND^DIC(390.01,"","@;.01","A",DGSOCIEN,1,"","","","TEXT")
+5 SET I=I+1
SET DGSOCCOD(I)=TEXT("DILIST","ID",1,".01")
SET DGSOCCOD(I,"IEN")=DGSOCIEN
End DoDot:2
End DoDot:1
+6 QUIT
NOFLW(DGSOCCOD) ; Perform followup dialog for patient that does not wish to enroll/register
+1 NEW DIR,DIC,DA,DGAR1,DGAR2
SET DGAR1=""
SET DGAR2=""
+2 WRITE !!
SET DIR("A",1)=" How does the patient feel now about registering in My HealtheVet?"
+3 SET DIR("A",2)=" "
SET DIR("A",3)=" 1) Patient is not interested."
+4 SET DIR("A",4)=" 2) Patient is interested."
SET DIR("A",5)=" "
+5 SET DIR(0)="SA^1:Patient is not interested;2:Patient is interested"
SET DIR("A")="Select a response: "
+6 DO ^DIR
IF $GET(Y)'="1"
DO ACTIONS(.DGAR1,DGAR2,$GET(DGDPTSOC),"S")
QUIT
+7 ; If patient isn't interested to be enrolled/register in MHV then update Enroll/Register,
+8 ; Authenticated, and Secure Message fields to "NO"
+9 NEW DIE,DR,DA,DGMHVNOW
SET DA=DFN
SET DGMHVNOW=$$NOW^XLFDT
+10 SET DIE="^DPT("
SET DR="537027////0;537030////"_DGMHVNOW_";537028////0;537029////0;537031////"_DGMHVNOW_";537032////"_DGMHVNOW
+11 DO ^DIE
+12 FOR DGRPFLD=537036:1:537038
DO FILRNA^DGMHVAC(DFN,DGRPFLD,+$ORDER(^DGMHV(390.03,"B","I am not interested.","")))
+13 QUIT
ACTIONS(DGMSACT,ACTSEL,DGENRQ,DGMHVMOD) ; Display MHV Socialization actions, allow selection, return selected actions in ACTSEL
+1 ; Input:
+2 ; DGMSACT - Array of selectable actions from MHV SOCIALIZATION ACTIONS (#390.02) file
+3 ; ACTSEL - Array of action(s) currently selected by clerk
+4 ; DGENRQ - Internal Entry Number (IEN) of the prospective MHV SOCIALIZATION (#537026) multiple in the PATIENT (#2) file into which
+5 ; the selected actions in ACTSEL will be stored.
+6 ; DGMHVMOD - Mode; the section of MHV functionality from which this is invoked. Used to screen selectable actions.
+7 ; "R" - Enrollment/Registration "S" - Socialization, "A" - Authentication field, "M" - Secure Messaging field
+8 KILL DIR,DGMSACT
DO CLEAR
+9 NEW DINUM,DIR,ACTCNT,DGACDONE,DGSTAY,DGACSAVE,DGACCNT
SET DGACDONE=0
SET DGACSAVE=0
+10 DO GETACTS(.DGMSACT,$GET(DGMHVMOD))
SET DGACCNT=+$ORDER(DGMSACT(""),-1)
+11 SET DIR(0)="SA^"
SET ACTCNT=0
FOR
SET ACTCNT=$ORDER(DGMSACT(ACTCNT))
if 'ACTCNT
QUIT
SET DIR(0)=DIR(0)_ACTCNT_":"_DGMSACT(ACTCNT)_";"
+12 SET $PIECE(DIR(0),"^",3)="D ACTRNSFM^DGMHV"
+13 FOR
if $GET(DGACDONE)
QUIT
DO ACTLOOP(.DIR,.DGMSACT,.ACTSEL)
+14 IF $GET(DGACSAVE)
IF $DATA(ACTSEL)>1
Begin DoDot:1
+15 IF $GET(DGENRQ)
IF '$GET(DGDPTSOC)
SET DGDPTSOC=DGENRQ
+16 NEW DGSEL,DGAIEN,DGMHVND,DGPLURAL
SET DGSEL=0
FOR DGPLURAL=1:1
SET DGSEL=$ORDER(ACTSEL(DGSEL))
if 'DGSEL
QUIT
Begin DoDot:2
+17 NEW DIE,DA,DIC
SET DGAIEN=$GET(ACTSEL(DGSEL,"IEN"))
SET DIC(0)="EZ"
SET DIC="^DPT("_DFN_",1,"_DGDPTSOC_",1,"
SET DA(3)=DFN
SET DA(2)=DGDPTSOC
+18 SET DA(1)=$ORDER(^DPT(DFN,1,DA(2),1,"A"),-1)+1
SET DINUM=DA(1)
SET X=DGAIEN
SET DGMHVND=DA(1)
SET DIC("DR")=".01////"_DGAIEN
DO FILE^DICN
IF $GET(DGENRQ)
Begin DoDot:3
+19 NEW DA,DIE,DIC,RSPDT
SET RSPDT=$$NOW^XLFDT
SET DIE="^DPT(DFN,1,"
SET DA(1)=DFN
SET DA=DGENRQ
SET DR=".01////"_RSPDT
DO ^DIE
End DoDot:3
+20 NEW DA,DIE,DIC
KILL DIE,DIC,DA
SET DIE="^DPT("_DFN_",1,"_DGDPTSOC_",1,"
SET DA(2)=DFN
SET DA(1)=DGDPTSOC
SET DA=$ORDER(^DPT(DFN,1,DGDPTSOC,1,"A"),-1)
+21 SET DR=".01////"_DGAIEN
DO ^DIE
End DoDot:2
+22 WRITE !,$SELECT($GET(DGPLURAL)=1:"Action",1:"Actions")," Filed...",!
HANG .5
End DoDot:1
SET DGMHVNOS=1
QUIT
+23 SET DGMHVOUT=1
+24 QUIT
ACTLOOP(DIR,DGMSACT,ACTSEL) ; Redisplay and reprompt user for action(s) until they're filed, or user aborts
+1 DO CLEAR
+2 SET DGSTAY=1
+3 WRITE !?2,"Action(s) taken today to assist patient with My HealtheVet registration."
+4 WRITE !?2,"-----------------------------------------------------------------------"
+5 DO ^DIR
+6 IF Y="^"!$GET(DIRUT)
WRITE !!
NEW DGREALQ
SET DGREALQ=1
Begin DoDot:1
+7 NEW DIR,Y
SET DIR(0)="Y"
SET DIR("A",1)="My HealtheVet registration questions are required to continue with this patient."
+8 SET DIR("A")="Are you sure you want to quit "
DO ^DIR
IF $GET(Y)
SET DGMHVOUT=1
SET DGACDONE=1
SET DGACSAVE=0
SET DGSTAY=0
QUIT
+9 SET DGSTAY=1
End DoDot:1
QUIT
+10 IF $GET(Y)>0
NEW DGSELL
FOR DGSELL=1:1:$LENGTH(Y,",")
NEW DGSELIT
SET DGSELIT=$PIECE(Y,",",DGSELL)
IF DGSELIT]""
MERGE ACTSEL(DGSELIT)=DGMSACT(DGSELIT)
+11 FOR
if '$GET(DGSTAY)
QUIT
Begin DoDot:1
+12 DO CLEAR
NEW DIR,SELAC,DGCNT,DGII
SET DGCNT=1
SET DGSTAY=0
+13 SET DIR("A",DGCNT)=""
SET DGCNT=DGCNT+1
+14 SET DIR("A",DGCNT)="Actions Selected:"
+15 ;"-----------------------------------------------------------------------"
SET DGCNT=DGCNT+1
SET DIR("A",DGCNT)=" "
+16 SET SELAC=""
FOR DGII=1:1
SET SELAC=$ORDER(ACTSEL(SELAC))
if 'SELAC
QUIT
Begin DoDot:2
+17 NEW SELACSUB,MARX
SET SELACSUB=0
DO TXT(ACTSEL(SELAC),65)
FOR
SET SELACSUB=$ORDER(MARX(SELACSUB))
if 'SELACSUB
QUIT
Begin DoDot:3
+18 SET DGCNT=DGCNT+1
SET DIR("A",DGCNT)=" "_$SELECT(SELACSUB=1:SELAC_" - ",1:" ")_" "_MARX(SELACSUB)
End DoDot:3
End DoDot:2
+19 SET DGCNT=DGCNT+1
SET DIR("A",DGCNT)=""
+20 SET DIR("A")=" (A)dd another, (D)elete an action, or <RET> to save and exit: "
SET DIR(0)="SAO^A:Add an Action;D:Delete an Action"
DO ^DIR
WRITE !
+21 if Y="A"
QUIT
+22 IF Y="D"
SET DGSTAY=1
DO DELETE(.ACTSEL)
QUIT
+23 IF Y="^"
WRITE !!
NEW DGREALQ
SET DGREALQ=1
Begin DoDot:2
+24 NEW DIR,Y
SET DIR(0)="Y"
SET DIR("A",1)="My HealtheVet registration information is required to continue with this patient."
+25 SET DIR("A")="Are you sure you want to quit "
DO ^DIR
IF $GET(Y)
SET DGMHVOUT=1
SET DGACDONE=1
SET DGACSAVE=0
SET DGSTAY=0
QUIT
+26 SET DGSTAY=1
End DoDot:2
QUIT
+27 SET DGACDONE=1
SET DGACSAVE=1
End DoDot:1
+28 QUIT
GETACTS(DGMSACT,DGMHVMOD) ; Get actions from the MHV SOCIALIZATION ACTIONS (#390.02) file; screen by mode (DGMHVMOD)
+1 ; Input: DGMHVMOD - Mode; MHV functionality from which this is invoked. Used to screen selectable Actions.
+2 ; DGMSACT - Array containing appropriate MHV actions, after screening based on mode (DGMHVMOD).
+3 NEW ACTIEN,ACTCNT,ACTTXT,SELCNT,DGMHVSAT
SET ACTCNT=0
SET SELCNT=0
+4 SET ACTIEN=0
FOR
SET ACTIEN=$ORDER(^DGMHV(390.02,ACTIEN))
if 'ACTIEN
QUIT
SET ACTTXT=$PIECE($GET(^DGMHV(390.02,ACTIEN,3,1,0)),"^")
IF ACTTXT]""
Begin DoDot:1
+5 NEW TXTND
SET TXTND=1
FOR
SET TXTND=$ORDER(^DGMHV(390.02,ACTIEN,3,TXTND))
if 'TXTND
QUIT
SET ACTTXT=ACTTXT_" "_^DGMHV(390.02,ACTIEN,3,TXTND,0)
+6 NEW ACTLLIST
DO ACTSCRN^DGMHVUTL(ACTIEN,.ACTLLIST)
IF ($GET(DGMHVMOD)]"")
if '$DATA(ACTLLIST(DGMHVMOD))
QUIT
+7 SET ACTCNT=ACTCNT+1
SET SELCNT=SELCNT+1
SET DGMSACT(ACTCNT)=ACTTXT
SET DGMSACT(ACTCNT,"IEN")=ACTIEN
+8 NEW MARX,ACTLINE
DO TXT(ACTTXT,65)
SET ACTLINE=0
FOR
SET ACTLINE=$ORDER(MARX(ACTLINE))
if 'ACTLINE
QUIT
Begin DoDot:2
+9 NEW DGDASH
SET DGDASH=$SELECT(ACTLINE=1&(ACTCNT<10):ACTCNT_" - ",(ACTLINE=1&(ACTCNT>9)):ACTCNT_" - ",1:" ")
+10 SET DIR("A",SELCNT)=" "_DGDASH_" "_MARX(ACTLINE)
SET SELCNT=SELCNT+1
End DoDot:2
End DoDot:1
+11 SET DIR("A",SELCNT+1)=" "
+12 SET DIR("A")=" Select an action or '^' to exit: "
+13 QUIT
DELETE(DGACTD) ; Delete one previously selected action
+1 ; Input : DGACTD - Array of MHV actions selected by clerk.
+2 KILL DGDELDIR,DIR
NEW DGDELAR,II,DGCNT,ZZ
SET DGCNT=0
+3 MERGE DGDELAR=DGACTD
+4 ;
+5 KILL DGACTD
MERGE DGACTD=DGDELAR
+6 SET DIR(0)="SAO^"
SET ZZ=0
FOR II=1:1
SET ZZ=$ORDER(DGDELAR(ZZ))
if 'ZZ
QUIT
SET DIR(0)=DIR(0)_ZZ_":"_DGDELAR(ZZ)_";"
+7 SET DIR("A")="Select an action to delete: "
DO ^DIR
IF $GET(Y)>0
IF $DATA(DGACTD(+Y))
KILL DGACTD(Y)
+8 WRITE !
DO CONT
IF '$DATA(DGACTD)
SET DGSTAY=0
DO CLEAR
+9 QUIT
REVERSE(PAD,DGREVTXT) ; Display DGREVTXT in reverse video
+1 NEW X,Y,IORVON,IORVOFF,DIR,DIRUT
+2 SET X="IORVON;IORVOFF"
SET PAD=+$GET(PAD)
+3 DO ENDR^%ZISS
+4 WRITE $CHAR(7)
WRITE ?PAD
if $DATA(IORVON)
WRITE IORVON
WRITE DGREVTXT
if $DATA(IORVOFF)
WRITE IORVOFF
+5 QUIT
TXT(TXT,LEN) ; Split string into multiple LEN length lines
+1 ;* Input: TXT = TXT string
+2 ;* LEN = format length
+3 ;* Output: MARX array.
+4 NEW OLD,X1,Y
DO SPLIT
KILL MARX
+5 SET X=0
SET X1=1
SET Y=""
FOR
SET X=$ORDER(OLD(X))
if 'X
QUIT
Begin DoDot:1
+6 IF $LENGTH(Y_OLD(X))>LEN
SET MARX(X1)=Y
SET X1=X1+1
SET Y=""
Begin DoDot:2
+7 IF $EXTRACT(MARX(X1-1),$LENGTH(MARX(X1-1)))'=" "
QUIT
+8 SET MARX(X1-1)=$EXTRACT(MARX(X1-1),1,$LENGTH(MARX(X1-1))-1)
End DoDot:2
+9 SET Y=Y_OLD(X)
End DoDot:1
+10 if Y]""
SET MARX(X1)=Y
+11 SET MARX=X1
+12 QUIT
SPLIT ; * Split a word string into individual words.
+1 ;* Input: TXT - Line of text
+2 ;* Input: LEN - Maximum length one line of text will be limited to
+3 ;* Output: OLD(X)
+4 NEW BSD,NEWSTR,X,X1,Y
+5 SET OLD(1)=TXT
if $LENGTH(TXT)<LEN
QUIT
+6 FOR BSD=" ","/","-"
if '$ORDER(OLD(0))
SET OLD(1)=TXT
if TXT[BSD
DO DELIM(BSD)
+7 IF '$ORDER(OLD(1))
IF ($LENGTH(TXT)>LEN)
DO LEN(1,TXT)
KILL OLD
Begin DoDot:1
+8 FOR X=0:0
SET X=$ORDER(NEWSTR(X))
if 'X
QUIT
SET OLD(X)=NEWSTR(X)
End DoDot:1
+9 QUIT
LEN(X1,OLD) ;* Wrap word to next line if it doesn't fit the display length
+1 NEW X
+2 if $LENGTH(OLD)'>LEN
QUIT
+3 SET X=$EXTRACT(OLD,1,($LENGTH(OLD)-1))
IF X["/"!(X["-")
QUIT
+4 IF $LENGTH(OLD)>LEN
FOR X=1:1
SET NEWSTR(X1)=$EXTRACT(OLD,((LEN*X)-LEN+1),(LEN*X))
SET X1=X1+1
if ($LENGTH(OLD)'>(LEN*X))
QUIT
+5 QUIT
DELIM(BSD) ; Split a string into individual words
+1 ; Input: BSD - Characters considered delimiters between words (i.e., for identifying/splitting-up-and/or-separating words)
+2 ; Input: OLD(n) - Text array containing
+3 ; Output: OLD(n) - Array containing pdated
+4 KILL NEWSTR
+5 SET X=0
SET X1=0
FOR
SET X=$ORDER(OLD(X))
if 'X
QUIT
FOR Y=1:1:$LENGTH(OLD(X),BSD)
Begin DoDot:1
+6 SET X1=X1+1
+7 SET NEWSTR(X1)=$PIECE(OLD(X),BSD,Y)
+8 IF $LENGTH(OLD(X),BSD)>1
IF (Y<$LENGTH(OLD(X),BSD))
SET NEWSTR(X1)=NEWSTR(X1)_BSD
+9 DO LEN(.X1,NEWSTR(X1))
End DoDot:1
+10 KILL OLD
FOR X=0:0
SET X=$ORDER(NEWSTR(X))
if 'X
QUIT
SET OLD(X)=NEWSTR(X)
+11 QUIT
CLEAR ; Clear the display
+1 DO CLEAR^VALM1
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 QUIT
CONT ; Prompt to Continue
+1 NEW DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+2 QUIT
ACTRNSFM ; Transform action prompt input
+1 QUIT
DSPLACT(DFN) ; Display all MHV actions associated with last 5 date/time stamps. If last action is one of the
+1 ; MHV Socialization actions, ask additional question about whether the patient was successfully enrolled/registered
+2 NEW TMPDT,LASTDT,DGACTDT,NXT1,NXT2,I,J,DGLACTS,DIC,DA,DGFLDAR
SET DGLACTS=""
+3 DO GETLACT^DGMHVUTL(DFN,.DGLACTS)
+4 WRITE !," Recent My HealtheVet actions taken by VistA Clerks "
+5 WRITE !,"--------------------------------------------------------------------"
+6 DO GETFLDS^DGMHVUTL(DFN,.DGFLDAR)
IF $ORDER(DGFLDAR(0))
MERGE DGLACTS=DGFLDAR
+7 IF '$ORDER(DGLACTS(0))
WRITE !?8," - NONE - ",!!
QUIT
+8 SET LASTDT=""
FOR
SET LASTDT=$ORDER(DGLACTS(LASTDT))
if 'LASTDT
QUIT
Begin DoDot:1
+9 SET DGACTDT=$$FMTE^XLFDT($PIECE(LASTDT,"."),2)
IF ($LENGTH(DGACTDT)<8)
Begin DoDot:2
+10 NEW NEWDT,IDT,DTPC
FOR IDT=1:1:$LENGTH(DGACTDT,"/")
Begin DoDot:3
+11 SET DTPC=$PIECE(DGACTDT,"/",IDT)
SET DTPC=$TRANSLATE($JUSTIFY(DTPC,2)," ",0)
SET NEWDT=$GET(NEWDT)_$SELECT(IDT=1:"",1:"/")_DTPC
End DoDot:3
+12 IF NEWDT?2N1"/"2N1"/"2N
SET DGACTDT=NEWDT
End DoDot:2
+13 SET NXT1=0
FOR I=1:1
SET NXT1=$ORDER(DGLACTS(LASTDT,NXT1))
if 'NXT1
QUIT
Begin DoDot:2
+14 SET NXT2=""
FOR J=1:1
SET NXT2=$ORDER(DGLACTS(LASTDT,NXT1,"TXT",NXT2))
if 'NXT2
QUIT
WRITE !
Begin DoDot:3
+15 NEW DGSP
SET DGSP=$SELECT($LENGTH($GET(DGLACTS(LASTDT,NXT1,"IEN")))>1:" ",1:" ")
+16 WRITE $SELECT($GET(TMPDT)'=LASTDT:DGACTDT,1:" ")
WRITE $SELECT((J=1):DGSP_" ",1:" "),$GET(DGLACTS(LASTDT,NXT1,"TXT",NXT2))
+17 SET TMPDT=LASTDT
End DoDot:3
End DoDot:2
End DoDot:1
+18 DO QUESUC^DGMHVUTL(DFN,.DGMHVOUT)
if ($GET(DGMHVOUT)]"")
QUIT
+19 QUIT
ACTHLP ; Help at action prompt
+1 WRITE !?5,"Please select one of the listed actions that most closely describes"
+2 WRITE !?5,"the actions taken today to help this patient register in My HealtheVet."
+3 QUIT
