VPSPDO1M ;DALOI/KML,WOIFO/BT - PDO OUTPUT DISPLAY - MEDS ;11/20/11 15:30
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Oct 21, 2011;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;IA #10103 - supported use of XLFDT functions
;IA #10104 - supported use of XLFSTR function
;
; The medication section of the PDO output specifically for the PATIENT ENTERED ALLERGY MEDICATION REVIEW
; which can be invoked by CPRS TIU components and as an RPC to be called by Vetlink staff-facing interface
;
MEDHDR(OREF) ; build medication sections for Patient Entered allergy medication review note
; active medications have an (RX) status of Active, Suspended, Hold, Provider Hold
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
;
D ADDUNDLN^VPSOBJ(OREF) ; DISPLAY UNDERSCORE
D ADDLJ^VPSOBJ(OREF,"*** MEDICATION REVIEW - PATIENT RESPONSE KEY *** ")
D ADDBLANK^VPSOBJ(OREF),ADDBLANK^VPSOBJ(OREF) ; add 2 blank lines
;
I $D(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS")) D ; the display of the medication patient response key occurs only if there are meds
. D ADDLJ^VPSOBJ(OREF,"'Y' TAKING as written;")
. D ADDLJ^VPSOBJ(OREF,"'N' NOT TAKING;")
. D ADDLJ^VPSOBJ(OREF,"'D' TAKING DIFFERENTLY;")
. D ADDLJ^VPSOBJ(OREF,"'?' patient UNSURE;")
. D ADDLJ^VPSOBJ(OREF,"'X' NO RESPONSE (incomplete session/no answer)")
. I STAFF D ADDLJ^VPSOBJ(OREF,">> indicates MARK FOR FOLLOW UP")
. D ADDUNDLN^VPSOBJ(OREF) ; DISPLAY UNDERSCORE
Q
;
MEDS(OREF,SAVMEDS) ; sort the displayed meds by active, NONVA, and PAST
; INPUT
; OREF : Object Reference for the VPS PDO object
; OUTPUT
; SAVMEDS : passed in by reference. array represents the list of medications to display at a given section
;
N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
;
; -- build active meds section
D ADDCJ^VPSOBJ(OREF,"*** ACTIVE MEDICATIONS *** ACTIVE MEDICATIONS ***")
N RXSTAT,MEDITMS
F RXSTAT=0,5,3,15 D GET(OREF,RXSTAT,.MEDITMS) ;get active, suspended, hold, provider hold meds
I $D(MEDITMS) D BLD(OREF,.MEDITMS,"ACTIVE")
N ACTIVE S ACTIVE=$$GETACTIV^VPSOBJ(OREF)
I 'ACTIVE D ADDLJ^VPSOBJ(OREF,"No active VA medications on file.")
K SAVMEDS M SAVMEDS=MEDITMS ; SAVMEDS to be used in the CHANGES SINCE algorithm
K MEDITMS
;
; -- build NON-VA meds section
D ADDBLANK^VPSOBJ(OREF)
D ADDCJ^VPSOBJ(OREF,"*** NON-VA MEDICATIONS *** NON-VA MEDICATIONS ***")
N NONVA D GETNONVA^VPSOBJ(OREF,.NONVA)
I '$D(NONVA) D ADDLJ^VPSOBJ(OREF,"No active Non-VA medications on file.")
I $D(NONVA) D BLDNONVA(OREF)
;
; -- build PAST meds section
D ADDUNDLN^VPSOBJ(OREF) ; DISPLAY UNDERSCORE
D ADDCJ^VPSOBJ(OREF,"*** EXPIRED & DISCONTINUED MEDS *** EXPIRED & DISCONTINUED MEDS ***")
N RXSTAT,MEDITMS
F RXSTAT=11,12,14,15 D GET(OREF,RXSTAT,.MEDITMS) ; get expired, discontinued, discontinued by provider, discontinued edit
I '$D(MEDITMS) D ADDLJ^VPSOBJ(OREF,"No Expired or Discontinued Medications on file.")
I $D(MEDITMS) D BLD(OREF,.MEDITMS,"PAST")
M SAVMEDS=MEDITMS ; SAVMEDS to be used in the CHANGES SINCE algorithm
K MEDITMS
Q
;
GET(OREF,RXSTAT,MEDITMS) ; get MED data
; INPUT
; OREF : Object Reference for the VPS PDO object
; RXSTAT : RX status. Medication list is displayed at specific sections of the note depending on status
; OUTPUT
; MEDITMS : passed in by reference. array represents the list of medications to display at a given section
;
N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
;
N MEDIEN S MEDIEN=0
F S MEDIEN=$O(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS","RXST",RXSTAT,MEDIEN)) Q:'MEDIEN D
. N MEDNAME S MEDNAME=$$GET1^DIQ(853.54,MEDIEN_","_LMRARDT_","_PTIEN_",",10) ; medication name
. Q:MEDNAME="" ; quit if medication name is null (PDO display requires a medication name)
. S MEDITMS(MEDNAME,MEDIEN)="" ; medications need to be displayed in alphabetical order; build array sorted by med name;
Q
;
BLDNONVA(OREF) ; build NON VA meds
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N NONVA D GETNONVA^VPSOBJ(OREF,.NONVA)
N NAME S NAME=""
;
F S NAME=$O(NONVA(NAME)) Q:NAME="" D
. D SETMEDNM^VPSOBJ(OREF,NAME)
. D SETPROPS(OREF,.NONVA) ; assign data to properties for ease of handling
. D NAMELINE(OREF) ; Add followup, patient response, med name
. D SIGLINES(OREF) ; Add SIG lines to result array
. D PRVLINES(OREF) ; Add provider lines
. D ADDNONVA(OREF) ; Add patient comments
;
K NONVA
Q
;
BLD(OREF,MEDITMS,TYPE) ; build the array of data associated with a given medication (at the 853.54 SUB-ENTRY)
; INPUT
; OREF : Object Reference for the VPS PDO object
; MEDITMS : passed in by reference. array represents the list of medications to display at a given section
; TYPE : "ACTIVE" or "PAST" medication
;
N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
N COL D GETFORMT^VPSOBJ(OREF,.COL)
;
N NONVA
N NAME S NAME=""
N MIEN S MIEN=0
D SETACTIV^VPSOBJ(OREF,0)
D SETMTYPE^VPSOBJ(OREF,TYPE)
D KILNONVA^VPSOBJ(OREF)
;
F S NAME=$O(MEDITMS(NAME)) Q:NAME="" F S MIEN=$O(MEDITMS(NAME,MIEN)) Q:'MIEN D
. D SETMEDNM^VPSOBJ(OREF,NAME)
. N MEDLST D GETS^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",","2;3;4;5;6;7;9;11;13;14;15;16;21;22","IE","MEDLST") ; refer to routine VPSMRAR2 for field references at subfile 853.54
. ;
. ; -- transform med data (fileman result) to FLD by field name
. N INEX,FLD
. ; initialize med fields
. F FLD=2,3,4,5,6,7,9,11,13,14,15,16,21,22 F INEX="E","I" S FLD(NAME,FLD,INEX)=""
. S FLD=0
. F S FLD=$O(MEDLST(853.54,MIEN_","_LMRARDT_","_PTIEN_",",FLD)) Q:'FLD F INEX="E","I" S FLD(NAME,FLD,INEX)=MEDLST(853.54,MIEN_","_LMRARDT_","_PTIEN_",",FLD,INEX)
. ;
. ; -- NonVA meds need to display in a separate section; save into separate array
. N ISNONVA S ISNONVA=(FLD(NAME,21,"I")="Y")
. I TYPE="ACTIVE",ISNONVA D APDNONVA^VPSOBJ(OREF,.FLD) K FLD Q
. ;
. ; -- ACTIVE (NON-VA = false) and PAST type continue here
. D SETACTIV^VPSOBJ(OREF,1)
. D SETPROPS(OREF,.FLD) ; assign data to properties for ease of handling
. D NAMELINE(OREF) ; Add followup, patient response, med name
. D SIGLINES(OREF) ; Add SIG lines to result array
. D PRVLINES(OREF) ; Add provider lines
. ;
. ; -- patient comment lines
. N PATCOMM D GCOMM^VPSPUTL1(LMRARDT,PTIEN,MIEN,STAFF,.COL,.PATCOMM)
. D SETPATCM^VPSOBJ(OREF,.PATCOMM)
. D PTCLINES(OREF) ; Add patient comments
. K MEDLST,PATCOMM,FLD
Q
;
SETPROPS(OREF,FLD) ; assign data to properties for ease of handling
; INPUT
; OREF : Object Reference for the VPS PDO object
; FLD : Med data by fieldname
;
N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
N NAME S NAME=$$GETMEDNM^VPSOBJ(OREF)
;
D SETLREFL^VPSOBJ(OREF,FLD(NAME,6,"E")) ;left refills
D SETMREFL^VPSOBJ(OREF,FLD(NAME,22,"E")) ;max refills
D SETSIG^VPSOBJ(OREF,FLD(NAME,13,"E")) ; SIG instruction
D SETPROV^VPSOBJ(OREF,FLD(NAME,2,"E")) ; provider
D SETDSPLY^VPSOBJ(OREF,FLD(NAME,5,"E")) ; days supplied
N MFILL S MFILL=$S(FLD(NAME,4,"I")]"":$$FMDIFF^XLFDT(DT,FLD(NAME,4,"I")),1:"") ; days of last refill (NOW - DATE LAST FILLED)
D SETMFILL^VPSOBJ(OREF,MFILL)
N NXFILLDT S NXFILLDT=$S(FLD(NAME,7,"I")]"":$$FMTE^XLFDT(FLD(NAME,7,"I"),2),1:"") ; DATE NEXT FILLED
D SETNFILL^VPSOBJ(OREF,NXFILLDT)
D SETRMLOC^VPSOBJ(OREF,FLD(NAME,3,"E")) ; remote fill location
D SETREMOT^VPSOBJ(OREF,FLD(NAME,9,"E")]"") ; remote med id exist
N MARKFOL S MARKFOL=FLD(NAME,16,"I") ; mark for follow-up for patient facilitated output
I STAFF,MARKFOL]"" S MARKFOL=">>" D SETMKFOL^VPSOBJ(OREF,MARKFOL)
D SETPATRP^VPSOBJ(OREF,FLD(NAME,11,"E")) ; MR preset patient response
Q
;
NAMELINE(OREF) ; Add followup, patient response, med name to result array
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
N MARKFOL S MARKFOL=$$GETMKFOL^VPSOBJ(OREF)
N PATRESP S PATRESP=$$GETPATRP^VPSOBJ(OREF)
N NAME S NAME=$$GETMEDNM^VPSOBJ(OREF)
;
N VPSX S VPSX=""
I STAFF S VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP"))
S VPSX=$$SETFLD^VPSPUTL1(PATRESP,VPSX,COL("PATRESP"))
S VPSX=$$SETFLD^VPSPUTL1(NAME,VPSX,COL("MEDNAME"))
D ADDPDO^VPSOBJ(OREF,VPSX)
Q
;
SIGLINES(OREF) ; Add SIG lines to result array
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N TYPE S TYPE=$$GETMTYPE^VPSOBJ(OREF)
N SIG S SIG(1)=$$GETSIG^VPSOBJ(OREF)
N LFTREFIL S LFTREFIL=$$GETLREFL^VPSOBJ(OREF)
N MAXREFIL S MAXREFIL=$$GETMREFL^VPSOBJ(OREF)
N NSIG S ^TMP("VPSPUTL1",$J)=0 D FCOMM^VPSPUTL1(.SIG,$P(COL("SIG"),U,2),.NSIG)
;
N LAST S LAST=$O(NSIG(""),-1)
N SUB S SUB=0
;
F S SUB=$O(NSIG(SUB)) Q:'SUB D
. N VPSX S VPSX=$$SETFLD^VPSPUTL1(NSIG(SUB),"",COL("SIG"))
. I SUB=LAST,TYPE'="NONVA" S VPSX=$$SETFLD^VPSPUTL1("Refills left: "_LFTREFIL_" of "_MAXREFIL,VPSX,COL("REFILLS"))
. D ADDPDO^VPSOBJ(OREF,VPSX)
Q
;
PRVLINES(OREF) ; Add provider lines
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N TYPE S TYPE=$$GETMTYPE^VPSOBJ(OREF)
N PROVIDER S PROVIDER=$$GETPROV^VPSOBJ(OREF)
N DAYSUPLY S DAYSUPLY=$$GETDSPLY^VPSOBJ(OREF)
N VPSX S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Provider: "_PROVIDER,VPSX,COL("PROVIDER"))
I TYPE'="NONVA" S VPSX=$$SETFLD^VPSPUTL1("Days supplied: "_DAYSUPLY,VPSX,COL("DAYS SUPPLIED"))
D ADDPDO^VPSOBJ(OREF,VPSX)
Q
;
PTCLINES(OREF) ; Add patient comments
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N REMOTE S REMOTE=$$GETREMOT^VPSOBJ(OREF)
I REMOTE D ADDREMOT(OREF)
I 'REMOTE D ADDLOCAL(OREF)
Q
;
ADDNONVA(OREF) ; Add Non-va patient comment
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
;
I $D(PATCOMM) D
. N RSS S RSS=0
. F S RSS=$O(PATCOMM(RSS)) Q:'RSS D
. . S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
. . D ADDPDO^VPSOBJ(OREF,VPSX)
D ADDBLANK^VPSOBJ(OREF) ; add a blank line between medication sets
Q
;
ADDREMOT(OREF) ; Add remote (cdw) patient comment, filled days, next fill date to result array
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N REMLOC S REMLOC=$$GETRMLOC^VPSOBJ(OREF) ; remote location
N FILLED S FILLED=$$GETMFILL^VPSOBJ(OREF) ; how long in days the medication was filled
N NXFILLDT S NXFILLDT=$$GETNFILL^VPSOBJ(OREF) ; Next Fill Date
N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
N MEDTYPE S MEDTYPE=$$GETMTYPE^VPSOBJ(OREF) ; "ACTIVE", "NONVA", "PAST" Medication
;
N VPSX S VPSX=""
S VPSX=$$SETFLD^VPSPUTL1("Remote: "_REMLOC,VPSX,COL("REMOTE"))
S VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
D ADDPDO^VPSOBJ(OREF,VPSX)
;
N RSS S RSS=0
N FIRST S FIRST=1
;
F S RSS=$O(PATCOMM(RSS)) Q:'RSS D
. S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
. I TYPE'="PAST",FIRST S VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")),FIRST=0
. D ADDPDO^VPSOBJ(OREF,VPSX)
;
I '$D(PATCOMM),TYPE'="PAST" D
. S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
. D ADDPDO^VPSOBJ(OREF,VPSX)
Q
;
ADDLOCAL(OREF) ; Add local vista patient comment, filled days, next fill date to result array
; INPUT
; OREF : Object Reference for the VPS PDO object
;
N VPSX S VPSX=""
N RSS S RSS=0
N NEXTFILL S NEXTFILL=0
N FIRST S FIRST=1
N COL D GETFORMT^VPSOBJ(OREF,.COL)
N FILLED S FILLED=$$GETMFILL^VPSOBJ(OREF) ; how long in days the medication was filled
N NXFILLDT S NXFILLDT=$$GETNFILL^VPSOBJ(OREF) ; Next Fill Date
N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
N MEDTYPE S MEDTYPE=$$GETMTYPE^VPSOBJ(OREF) ; "ACTIVE", "NONVA", "PAST" Medication
;
F S RSS=$O(PATCOMM(RSS)) Q:'RSS D
. S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
. I FIRST S VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED")) D ADDPDO^VPSOBJ(OREF,VPSX) S FIRST=0 Q
. I TYPE'="PAST",'FIRST,'NEXTFILL S VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")),NEXTFILL=1
. D ADDPDO^VPSOBJ(OREF,VPSX)
;
I '$D(PATCOMM) D
. S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
. D ADDPDO^VPSOBJ(OREF,VPSX)
;
I TYPE="ACTIVE",'NEXTFILL S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")) D ADDPDO^VPSOBJ(OREF,VPSX)
D ADDBLANK^VPSOBJ(OREF) ; add a blank line between medication sets
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSPDO1M 13175 printed Apr 09, 2024@21:45:25 Page 2
VPSPDO1M ;DALOI/KML,WOIFO/BT - PDO OUTPUT DISPLAY - MEDS ;11/20/11 15:30
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Oct 21, 2011;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;IA #10103 - supported use of XLFDT functions
+6 ;IA #10104 - supported use of XLFSTR function
+7 ;
+8 ; The medication section of the PDO output specifically for the PATIENT ENTERED ALLERGY MEDICATION REVIEW
+9 ; which can be invoked by CPRS TIU components and as an RPC to be called by Vetlink staff-facing interface
+10 ;
MEDHDR(OREF) ; build medication sections for Patient Entered allergy medication review note
+1 ; active medications have an (RX) status of Active, Suspended, Hold, Provider Hold
+2 ; INPUT
+3 ; OREF : Object Reference for the VPS PDO object
+4 ;
+5 NEW PTIEN
SET PTIEN=$$GETDFN^VPSOBJ(OREF)
+6 NEW LMRARDT
SET LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
+7 NEW STAFF
SET STAFF=$$GETSTAFF^VPSOBJ(OREF)
+8 ;
+9 ; DISPLAY UNDERSCORE
DO ADDUNDLN^VPSOBJ(OREF)
+10 DO ADDLJ^VPSOBJ(OREF,"*** MEDICATION REVIEW - PATIENT RESPONSE KEY *** ")
+11 ; add 2 blank lines
DO ADDBLANK^VPSOBJ(OREF)
DO ADDBLANK^VPSOBJ(OREF)
+12 ;
+13 ; the display of the medication patient response key occurs only if there are meds
IF $DATA(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS"))
Begin DoDot:1
+14 DO ADDLJ^VPSOBJ(OREF,"'Y' TAKING as written;")
+15 DO ADDLJ^VPSOBJ(OREF,"'N' NOT TAKING;")
+16 DO ADDLJ^VPSOBJ(OREF,"'D' TAKING DIFFERENTLY;")
+17 DO ADDLJ^VPSOBJ(OREF,"'?' patient UNSURE;")
+18 DO ADDLJ^VPSOBJ(OREF,"'X' NO RESPONSE (incomplete session/no answer)")
+19 IF STAFF
DO ADDLJ^VPSOBJ(OREF,">> indicates MARK FOR FOLLOW UP")
+20 ; DISPLAY UNDERSCORE
DO ADDUNDLN^VPSOBJ(OREF)
End DoDot:1
+21 QUIT
+22 ;
MEDS(OREF,SAVMEDS) ; sort the displayed meds by active, NONVA, and PAST
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ; OUTPUT
+4 ; SAVMEDS : passed in by reference. array represents the list of medications to display at a given section
+5 ;
+6 NEW PTIEN
SET PTIEN=$$GETDFN^VPSOBJ(OREF)
+7 NEW LMRARDT
SET LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
+8 ;
+9 ; -- build active meds section
+10 DO ADDCJ^VPSOBJ(OREF,"*** ACTIVE MEDICATIONS *** ACTIVE MEDICATIONS ***")
+11 NEW RXSTAT,MEDITMS
+12 ;get active, suspended, hold, provider hold meds
FOR RXSTAT=0,5,3,15
DO GET(OREF,RXSTAT,.MEDITMS)
+13 IF $DATA(MEDITMS)
DO BLD(OREF,.MEDITMS,"ACTIVE")
+14 NEW ACTIVE
SET ACTIVE=$$GETACTIV^VPSOBJ(OREF)
+15 IF 'ACTIVE
DO ADDLJ^VPSOBJ(OREF,"No active VA medications on file.")
+16 ; SAVMEDS to be used in the CHANGES SINCE algorithm
KILL SAVMEDS
MERGE SAVMEDS=MEDITMS
+17 KILL MEDITMS
+18 ;
+19 ; -- build NON-VA meds section
+20 DO ADDBLANK^VPSOBJ(OREF)
+21 DO ADDCJ^VPSOBJ(OREF,"*** NON-VA MEDICATIONS *** NON-VA MEDICATIONS ***")
+22 NEW NONVA
DO GETNONVA^VPSOBJ(OREF,.NONVA)
+23 IF '$DATA(NONVA)
DO ADDLJ^VPSOBJ(OREF,"No active Non-VA medications on file.")
+24 IF $DATA(NONVA)
DO BLDNONVA(OREF)
+25 ;
+26 ; -- build PAST meds section
+27 ; DISPLAY UNDERSCORE
DO ADDUNDLN^VPSOBJ(OREF)
+28 DO ADDCJ^VPSOBJ(OREF,"*** EXPIRED & DISCONTINUED MEDS *** EXPIRED & DISCONTINUED MEDS ***")
+29 NEW RXSTAT,MEDITMS
+30 ; get expired, discontinued, discontinued by provider, discontinued edit
FOR RXSTAT=11,12,14,15
DO GET(OREF,RXSTAT,.MEDITMS)
+31 IF '$DATA(MEDITMS)
DO ADDLJ^VPSOBJ(OREF,"No Expired or Discontinued Medications on file.")
+32 IF $DATA(MEDITMS)
DO BLD(OREF,.MEDITMS,"PAST")
+33 ; SAVMEDS to be used in the CHANGES SINCE algorithm
MERGE SAVMEDS=MEDITMS
+34 KILL MEDITMS
+35 QUIT
+36 ;
GET(OREF,RXSTAT,MEDITMS) ; get MED data
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ; RXSTAT : RX status. Medication list is displayed at specific sections of the note depending on status
+4 ; OUTPUT
+5 ; MEDITMS : passed in by reference. array represents the list of medications to display at a given section
+6 ;
+7 NEW PTIEN
SET PTIEN=$$GETDFN^VPSOBJ(OREF)
+8 NEW LMRARDT
SET LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
+9 ;
+10 NEW MEDIEN
SET MEDIEN=0
+11 FOR
SET MEDIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS","RXST",RXSTAT,MEDIEN))
if 'MEDIEN
QUIT
Begin DoDot:1
+12 ; medication name
NEW MEDNAME
SET MEDNAME=$$GET1^DIQ(853.54,MEDIEN_","_LMRARDT_","_PTIEN_",",10)
+13 ; quit if medication name is null (PDO display requires a medication name)
if MEDNAME=""
QUIT
+14 ; medications need to be displayed in alphabetical order; build array sorted by med name;
SET MEDITMS(MEDNAME,MEDIEN)=""
End DoDot:1
+15 QUIT
+16 ;
BLDNONVA(OREF) ; build NON VA meds
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW NONVA
DO GETNONVA^VPSOBJ(OREF,.NONVA)
+5 NEW NAME
SET NAME=""
+6 ;
+7 FOR
SET NAME=$ORDER(NONVA(NAME))
if NAME=""
QUIT
Begin DoDot:1
+8 DO SETMEDNM^VPSOBJ(OREF,NAME)
+9 ; assign data to properties for ease of handling
DO SETPROPS(OREF,.NONVA)
+10 ; Add followup, patient response, med name
DO NAMELINE(OREF)
+11 ; Add SIG lines to result array
DO SIGLINES(OREF)
+12 ; Add provider lines
DO PRVLINES(OREF)
+13 ; Add patient comments
DO ADDNONVA(OREF)
End DoDot:1
+14 ;
+15 KILL NONVA
+16 QUIT
+17 ;
BLD(OREF,MEDITMS,TYPE) ; build the array of data associated with a given medication (at the 853.54 SUB-ENTRY)
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ; MEDITMS : passed in by reference. array represents the list of medications to display at a given section
+4 ; TYPE : "ACTIVE" or "PAST" medication
+5 ;
+6 NEW PTIEN
SET PTIEN=$$GETDFN^VPSOBJ(OREF)
+7 NEW LMRARDT
SET LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
+8 NEW STAFF
SET STAFF=$$GETSTAFF^VPSOBJ(OREF)
+9 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+10 ;
+11 NEW NONVA
+12 NEW NAME
SET NAME=""
+13 NEW MIEN
SET MIEN=0
+14 DO SETACTIV^VPSOBJ(OREF,0)
+15 DO SETMTYPE^VPSOBJ(OREF,TYPE)
+16 DO KILNONVA^VPSOBJ(OREF)
+17 ;
+18 FOR
SET NAME=$ORDER(MEDITMS(NAME))
if NAME=""
QUIT
FOR
SET MIEN=$ORDER(MEDITMS(NAME,MIEN))
if 'MIEN
QUIT
Begin DoDot:1
+19 DO SETMEDNM^VPSOBJ(OREF,NAME)
+20 ; refer to routine VPSMRAR2 for field references at subfile 853.54
NEW MEDLST
DO GETS^DIQ(853.54,MIEN_","_LMRARDT_","_PTIEN_",","2;3;4;5;6;7;9;11;13;14;15;16;21;22","IE","MEDLST")
+21 ;
+22 ; -- transform med data (fileman result) to FLD by field name
+23 NEW INEX,FLD
+24 ; initialize med fields
+25 FOR FLD=2,3,4,5,6,7,9,11,13,14,15,16,21,22
FOR INEX="E","I"
SET FLD(NAME,FLD,INEX)=""
+26 SET FLD=0
+27 FOR
SET FLD=$ORDER(MEDLST(853.54,MIEN_","_LMRARDT_","_PTIEN_",",FLD))
if 'FLD
QUIT
FOR INEX="E","I"
SET FLD(NAME,FLD,INEX)=MEDLST(853.54,MIEN_","_LMRARDT_","_PTIEN_",",FLD,INEX)
+28 ;
+29 ; -- NonVA meds need to display in a separate section; save into separate array
+30 NEW ISNONVA
SET ISNONVA=(FLD(NAME,21,"I")="Y")
+31 IF TYPE="ACTIVE"
IF ISNONVA
DO APDNONVA^VPSOBJ(OREF,.FLD)
KILL FLD
QUIT
+32 ;
+33 ; -- ACTIVE (NON-VA = false) and PAST type continue here
+34 DO SETACTIV^VPSOBJ(OREF,1)
+35 ; assign data to properties for ease of handling
DO SETPROPS(OREF,.FLD)
+36 ; Add followup, patient response, med name
DO NAMELINE(OREF)
+37 ; Add SIG lines to result array
DO SIGLINES(OREF)
+38 ; Add provider lines
DO PRVLINES(OREF)
+39 ;
+40 ; -- patient comment lines
+41 NEW PATCOMM
DO GCOMM^VPSPUTL1(LMRARDT,PTIEN,MIEN,STAFF,.COL,.PATCOMM)
+42 DO SETPATCM^VPSOBJ(OREF,.PATCOMM)
+43 ; Add patient comments
DO PTCLINES(OREF)
+44 KILL MEDLST,PATCOMM,FLD
End DoDot:1
+45 QUIT
+46 ;
SETPROPS(OREF,FLD) ; assign data to properties for ease of handling
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ; FLD : Med data by fieldname
+4 ;
+5 NEW PTIEN
SET PTIEN=$$GETDFN^VPSOBJ(OREF)
+6 NEW LMRARDT
SET LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
+7 NEW STAFF
SET STAFF=$$GETSTAFF^VPSOBJ(OREF)
+8 NEW NAME
SET NAME=$$GETMEDNM^VPSOBJ(OREF)
+9 ;
+10 ;left refills
DO SETLREFL^VPSOBJ(OREF,FLD(NAME,6,"E"))
+11 ;max refills
DO SETMREFL^VPSOBJ(OREF,FLD(NAME,22,"E"))
+12 ; SIG instruction
DO SETSIG^VPSOBJ(OREF,FLD(NAME,13,"E"))
+13 ; provider
DO SETPROV^VPSOBJ(OREF,FLD(NAME,2,"E"))
+14 ; days supplied
DO SETDSPLY^VPSOBJ(OREF,FLD(NAME,5,"E"))
+15 ; days of last refill (NOW - DATE LAST FILLED)
NEW MFILL
SET MFILL=$SELECT(FLD(NAME,4,"I")]"":$$FMDIFF^XLFDT(DT,FLD(NAME,4,"I")),1:"")
+16 DO SETMFILL^VPSOBJ(OREF,MFILL)
+17 ; DATE NEXT FILLED
NEW NXFILLDT
SET NXFILLDT=$SELECT(FLD(NAME,7,"I")]"":$$FMTE^XLFDT(FLD(NAME,7,"I"),2),1:"")
+18 DO SETNFILL^VPSOBJ(OREF,NXFILLDT)
+19 ; remote fill location
DO SETRMLOC^VPSOBJ(OREF,FLD(NAME,3,"E"))
+20 ; remote med id exist
DO SETREMOT^VPSOBJ(OREF,FLD(NAME,9,"E")]"")
+21 ; mark for follow-up for patient facilitated output
NEW MARKFOL
SET MARKFOL=FLD(NAME,16,"I")
+22 IF STAFF
IF MARKFOL]""
SET MARKFOL=">>"
DO SETMKFOL^VPSOBJ(OREF,MARKFOL)
+23 ; MR preset patient response
DO SETPATRP^VPSOBJ(OREF,FLD(NAME,11,"E"))
+24 QUIT
+25 ;
NAMELINE(OREF) ; Add followup, patient response, med name to result array
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+5 NEW STAFF
SET STAFF=$$GETSTAFF^VPSOBJ(OREF)
+6 NEW MARKFOL
SET MARKFOL=$$GETMKFOL^VPSOBJ(OREF)
+7 NEW PATRESP
SET PATRESP=$$GETPATRP^VPSOBJ(OREF)
+8 NEW NAME
SET NAME=$$GETMEDNM^VPSOBJ(OREF)
+9 ;
+10 NEW VPSX
SET VPSX=""
+11 IF STAFF
SET VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP"))
+12 SET VPSX=$$SETFLD^VPSPUTL1(PATRESP,VPSX,COL("PATRESP"))
+13 SET VPSX=$$SETFLD^VPSPUTL1(NAME,VPSX,COL("MEDNAME"))
+14 DO ADDPDO^VPSOBJ(OREF,VPSX)
+15 QUIT
+16 ;
SIGLINES(OREF) ; Add SIG lines to result array
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+5 NEW TYPE
SET TYPE=$$GETMTYPE^VPSOBJ(OREF)
+6 NEW SIG
SET SIG(1)=$$GETSIG^VPSOBJ(OREF)
+7 NEW LFTREFIL
SET LFTREFIL=$$GETLREFL^VPSOBJ(OREF)
+8 NEW MAXREFIL
SET MAXREFIL=$$GETMREFL^VPSOBJ(OREF)
+9 NEW NSIG
SET ^TMP("VPSPUTL1",$JOB)=0
DO FCOMM^VPSPUTL1(.SIG,$PIECE(COL("SIG"),U,2),.NSIG)
+10 ;
+11 NEW LAST
SET LAST=$ORDER(NSIG(""),-1)
+12 NEW SUB
SET SUB=0
+13 ;
+14 FOR
SET SUB=$ORDER(NSIG(SUB))
if 'SUB
QUIT
Begin DoDot:1
+15 NEW VPSX
SET VPSX=$$SETFLD^VPSPUTL1(NSIG(SUB),"",COL("SIG"))
+16 IF SUB=LAST
IF TYPE'="NONVA"
SET VPSX=$$SETFLD^VPSPUTL1("Refills left: "_LFTREFIL_" of "_MAXREFIL,VPSX,COL("REFILLS"))
+17 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:1
+18 QUIT
+19 ;
PRVLINES(OREF) ; Add provider lines
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+5 NEW TYPE
SET TYPE=$$GETMTYPE^VPSOBJ(OREF)
+6 NEW PROVIDER
SET PROVIDER=$$GETPROV^VPSOBJ(OREF)
+7 NEW DAYSUPLY
SET DAYSUPLY=$$GETDSPLY^VPSOBJ(OREF)
+8 NEW VPSX
SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1("Provider: "_PROVIDER,VPSX,COL("PROVIDER"))
+9 IF TYPE'="NONVA"
SET VPSX=$$SETFLD^VPSPUTL1("Days supplied: "_DAYSUPLY,VPSX,COL("DAYS SUPPLIED"))
+10 DO ADDPDO^VPSOBJ(OREF,VPSX)
+11 QUIT
+12 ;
PTCLINES(OREF) ; Add patient comments
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW REMOTE
SET REMOTE=$$GETREMOT^VPSOBJ(OREF)
+5 IF REMOTE
DO ADDREMOT(OREF)
+6 IF 'REMOTE
DO ADDLOCAL(OREF)
+7 QUIT
+8 ;
ADDNONVA(OREF) ; Add Non-va patient comment
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+5 ; Patient comments
NEW PATCOMM
DO GETPATCM^VPSOBJ(OREF,.PATCOMM)
+6 ;
+7 IF $DATA(PATCOMM)
Begin DoDot:1
+8 NEW RSS
SET RSS=0
+9 FOR
SET RSS=$ORDER(PATCOMM(RSS))
if 'RSS
QUIT
Begin DoDot:2
+10 SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
+11 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:2
End DoDot:1
+12 ; add a blank line between medication sets
DO ADDBLANK^VPSOBJ(OREF)
+13 QUIT
+14 ;
ADDREMOT(OREF) ; Add remote (cdw) patient comment, filled days, next fill date to result array
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+5 ; remote location
NEW REMLOC
SET REMLOC=$$GETRMLOC^VPSOBJ(OREF)
+6 ; how long in days the medication was filled
NEW FILLED
SET FILLED=$$GETMFILL^VPSOBJ(OREF)
+7 ; Next Fill Date
NEW NXFILLDT
SET NXFILLDT=$$GETNFILL^VPSOBJ(OREF)
+8 ; Patient comments
NEW PATCOMM
DO GETPATCM^VPSOBJ(OREF,.PATCOMM)
+9 ; "ACTIVE", "NONVA", "PAST" Medication
NEW MEDTYPE
SET MEDTYPE=$$GETMTYPE^VPSOBJ(OREF)
+10 ;
+11 NEW VPSX
SET VPSX=""
+12 SET VPSX=$$SETFLD^VPSPUTL1("Remote: "_REMLOC,VPSX,COL("REMOTE"))
+13 SET VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
+14 DO ADDPDO^VPSOBJ(OREF,VPSX)
+15 ;
+16 NEW RSS
SET RSS=0
+17 NEW FIRST
SET FIRST=1
+18 ;
+19 FOR
SET RSS=$ORDER(PATCOMM(RSS))
if 'RSS
QUIT
Begin DoDot:1
+20 SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
+21 IF TYPE'="PAST"
IF FIRST
SET VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
SET FIRST=0
+22 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:1
+23 ;
+24 IF '$DATA(PATCOMM)
IF TYPE'="PAST"
Begin DoDot:1
+25 SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
+26 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:1
+27 QUIT
+28 ;
ADDLOCAL(OREF) ; Add local vista patient comment, filled days, next fill date to result array
+1 ; INPUT
+2 ; OREF : Object Reference for the VPS PDO object
+3 ;
+4 NEW VPSX
SET VPSX=""
+5 NEW RSS
SET RSS=0
+6 NEW NEXTFILL
SET NEXTFILL=0
+7 NEW FIRST
SET FIRST=1
+8 NEW COL
DO GETFORMT^VPSOBJ(OREF,.COL)
+9 ; how long in days the medication was filled
NEW FILLED
SET FILLED=$$GETMFILL^VPSOBJ(OREF)
+10 ; Next Fill Date
NEW NXFILLDT
SET NXFILLDT=$$GETNFILL^VPSOBJ(OREF)
+11 ; Patient comments
NEW PATCOMM
DO GETPATCM^VPSOBJ(OREF,.PATCOMM)
+12 ; "ACTIVE", "NONVA", "PAST" Medication
NEW MEDTYPE
SET MEDTYPE=$$GETMTYPE^VPSOBJ(OREF)
+13 ;
+14 FOR
SET RSS=$ORDER(PATCOMM(RSS))
if 'RSS
QUIT
Begin DoDot:1
+15 SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
+16 IF FIRST
SET VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
DO ADDPDO^VPSOBJ(OREF,VPSX)
SET FIRST=0
QUIT
+17 IF TYPE'="PAST"
IF 'FIRST
IF 'NEXTFILL
SET VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
SET NEXTFILL=1
+18 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:1
+19 ;
+20 IF '$DATA(PATCOMM)
Begin DoDot:1
+21 SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
+22 DO ADDPDO^VPSOBJ(OREF,VPSX)
End DoDot:1
+23 ;
+24 IF TYPE="ACTIVE"
IF 'NEXTFILL
SET VPSX=""
SET VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
DO ADDPDO^VPSOBJ(OREF,VPSX)
+25 ; add a blank line between medication sets
DO ADDBLANK^VPSOBJ(OREF)
+26 QUIT
