- 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 Feb 19, 2025@00:10:17 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