Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSPDO1M

VPSPDO1M.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;IA #10103 - supported use of XLFDT functions
  1.  ;IA #10104 - supported use of XLFSTR function
  1.  ;
  1.  ; The medication section of the PDO output specifically for the PATIENT ENTERED ALLERGY MEDICATION REVIEW
  1.  ; which can be invoked by CPRS TIU components and as an RPC to be called by Vetlink staff-facing interface
  1.  ;
  1. 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
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  ;
  1.  D ADDUNDLN^VPSOBJ(OREF)  ; DISPLAY UNDERSCORE
  1.  D ADDLJ^VPSOBJ(OREF,"*** MEDICATION REVIEW - PATIENT RESPONSE KEY *** ")
  1.  D ADDBLANK^VPSOBJ(OREF),ADDBLANK^VPSOBJ(OREF)  ; add 2 blank lines
  1.  ;
  1.  I $D(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS")) D  ; the display of the medication patient response key occurs only if there are meds
  1.  . D ADDLJ^VPSOBJ(OREF,"'Y' TAKING as written;")
  1.  . D ADDLJ^VPSOBJ(OREF,"'N' NOT TAKING;")
  1.  . D ADDLJ^VPSOBJ(OREF,"'D' TAKING DIFFERENTLY;")
  1.  . D ADDLJ^VPSOBJ(OREF,"'?' patient UNSURE;")
  1.  . D ADDLJ^VPSOBJ(OREF,"'X' NO RESPONSE (incomplete session/no answer)")
  1.  . I STAFF D ADDLJ^VPSOBJ(OREF,">> indicates MARK FOR FOLLOW UP")
  1.  . D ADDUNDLN^VPSOBJ(OREF)  ; DISPLAY UNDERSCORE
  1.  Q
  1.  ;
  1. MEDS(OREF,SAVMEDS) ; sort the displayed meds by active, NONVA, and PAST
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ; OUTPUT
  1.  ;   SAVMEDS  : passed in by reference.  array represents the list of medications to display at a given section
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  ; -- build active meds section
  1.  D ADDCJ^VPSOBJ(OREF,"*** ACTIVE MEDICATIONS   ***   ACTIVE MEDICATIONS   ***")
  1.  N RXSTAT,MEDITMS
  1.  F RXSTAT=0,5,3,15 D GET(OREF,RXSTAT,.MEDITMS) ;get active, suspended, hold, provider hold meds
  1.  I $D(MEDITMS) D BLD(OREF,.MEDITMS,"ACTIVE")
  1.  N ACTIVE S ACTIVE=$$GETACTIV^VPSOBJ(OREF)
  1.  I 'ACTIVE D ADDLJ^VPSOBJ(OREF,"No active VA medications on file.")
  1.  K SAVMEDS M SAVMEDS=MEDITMS ; SAVMEDS to be used in the CHANGES SINCE algorithm
  1.  K MEDITMS
  1.  ;
  1.  ; -- build NON-VA meds section
  1.  D ADDBLANK^VPSOBJ(OREF)
  1.  D ADDCJ^VPSOBJ(OREF,"***   NON-VA MEDICATIONS   ***   NON-VA MEDICATIONS   ***")
  1.  N NONVA D GETNONVA^VPSOBJ(OREF,.NONVA)
  1.  I '$D(NONVA) D ADDLJ^VPSOBJ(OREF,"No active Non-VA medications on file.")
  1.  I $D(NONVA) D BLDNONVA(OREF)
  1.  ;
  1.  ; -- build PAST meds section
  1.  D ADDUNDLN^VPSOBJ(OREF)  ; DISPLAY UNDERSCORE
  1.  D ADDCJ^VPSOBJ(OREF,"***   EXPIRED & DISCONTINUED MEDS   ***   EXPIRED & DISCONTINUED MEDS   ***")
  1.  N RXSTAT,MEDITMS
  1.  F RXSTAT=11,12,14,15 D GET(OREF,RXSTAT,.MEDITMS) ; get expired, discontinued, discontinued by provider, discontinued edit
  1.  I '$D(MEDITMS) D ADDLJ^VPSOBJ(OREF,"No Expired or Discontinued Medications on file.")
  1.  I $D(MEDITMS) D BLD(OREF,.MEDITMS,"PAST")
  1.  M SAVMEDS=MEDITMS ; SAVMEDS to be used in the CHANGES SINCE algorithm
  1.  K MEDITMS
  1.  Q
  1.  ;
  1. GET(OREF,RXSTAT,MEDITMS) ; get MED data
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;   RXSTAT   : RX status.  Medication list is displayed at specific sections of the note depending on status
  1.  ; OUTPUT
  1.  ;   MEDITMS  : passed in by reference.  array represents the list of medications to display at a given section
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  N MEDIEN S MEDIEN=0
  1.  F  S MEDIEN=$O(^VPS(853.5,PTIEN,"MRAR",LMRARDT,"MEDS","RXST",RXSTAT,MEDIEN)) Q:'MEDIEN  D
  1.  . N MEDNAME S MEDNAME=$$GET1^DIQ(853.54,MEDIEN_","_LMRARDT_","_PTIEN_",",10) ; medication name
  1.  . Q:MEDNAME=""  ; quit if medication name is null (PDO display requires a medication name)
  1.  . S MEDITMS(MEDNAME,MEDIEN)="" ; medications need to be displayed in alphabetical order; build array sorted by med name;
  1.  Q
  1.  ;
  1. BLDNONVA(OREF) ; build NON VA meds
  1.  ; INPUT
  1.  ;   OREF    : Object Reference for the VPS PDO object
  1.  ;
  1.  N NONVA D GETNONVA^VPSOBJ(OREF,.NONVA)
  1.  N NAME S NAME=""
  1.  ;
  1.  F  S NAME=$O(NONVA(NAME)) Q:NAME=""  D 
  1.  . D SETMEDNM^VPSOBJ(OREF,NAME)
  1.  . D SETPROPS(OREF,.NONVA) ; assign data to properties for ease of handling
  1.  . D NAMELINE(OREF) ; Add followup, patient response, med name 
  1.  . D SIGLINES(OREF) ; Add SIG lines to result array
  1.  . D PRVLINES(OREF) ; Add provider lines
  1.  . D ADDNONVA(OREF) ; Add patient comments 
  1.  ;
  1.  K NONVA
  1.  Q
  1.  ;
  1. BLD(OREF,MEDITMS,TYPE) ; build the array of data associated with a given medication (at the 853.54 SUB-ENTRY)
  1.  ; INPUT
  1.  ;   OREF    : Object Reference for the VPS PDO object
  1.  ;   MEDITMS : passed in by reference.  array represents the list of medications to display at a given section
  1.  ;   TYPE    : "ACTIVE" or "PAST" medication
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  ;
  1.  N NONVA
  1.  N NAME S NAME=""
  1.  N MIEN S MIEN=0
  1.  D SETACTIV^VPSOBJ(OREF,0)
  1.  D SETMTYPE^VPSOBJ(OREF,TYPE)
  1.  D KILNONVA^VPSOBJ(OREF)
  1.  ;
  1.  F  S NAME=$O(MEDITMS(NAME)) Q:NAME=""  F  S MIEN=$O(MEDITMS(NAME,MIEN)) Q:'MIEN  D
  1.  . D SETMEDNM^VPSOBJ(OREF,NAME)
  1.  . 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
  1.  . ;
  1.  . ; -- transform med data (fileman result) to FLD by field name
  1.  . N INEX,FLD
  1.  . ; initialize med fields
  1.  . 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)=""
  1.  . S FLD=0
  1.  . 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)
  1.  . ;
  1.  . ; -- NonVA meds need to display in a separate section; save into separate array
  1.  . N ISNONVA S ISNONVA=(FLD(NAME,21,"I")="Y")
  1.  . I TYPE="ACTIVE",ISNONVA D APDNONVA^VPSOBJ(OREF,.FLD) K FLD Q
  1.  . ;
  1.  . ; -- ACTIVE (NON-VA = false) and PAST type continue here
  1.  . D SETACTIV^VPSOBJ(OREF,1)
  1.  . D SETPROPS(OREF,.FLD) ; assign data to properties for ease of handling
  1.  . D NAMELINE(OREF) ; Add followup, patient response, med name 
  1.  . D SIGLINES(OREF) ; Add SIG lines to result array
  1.  . D PRVLINES(OREF) ; Add provider lines
  1.  . ;
  1.  . ; -- patient comment lines
  1.  . N PATCOMM D GCOMM^VPSPUTL1(LMRARDT,PTIEN,MIEN,STAFF,.COL,.PATCOMM)
  1.  . D SETPATCM^VPSOBJ(OREF,.PATCOMM)
  1.  . D PTCLINES(OREF) ; Add patient comments 
  1.  . K MEDLST,PATCOMM,FLD
  1.  Q
  1.  ;
  1. SETPROPS(OREF,FLD) ; assign data to properties for ease of handling
  1.  ; INPUT
  1.  ;   OREF   : Object Reference for the VPS PDO object
  1.  ;   FLD    : Med data by fieldname
  1.  ; 
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N NAME S NAME=$$GETMEDNM^VPSOBJ(OREF)
  1.  ;
  1.  D SETLREFL^VPSOBJ(OREF,FLD(NAME,6,"E")) ;left refills
  1.  D SETMREFL^VPSOBJ(OREF,FLD(NAME,22,"E")) ;max refills
  1.  D SETSIG^VPSOBJ(OREF,FLD(NAME,13,"E")) ; SIG instruction
  1.  D SETPROV^VPSOBJ(OREF,FLD(NAME,2,"E")) ; provider
  1.  D SETDSPLY^VPSOBJ(OREF,FLD(NAME,5,"E")) ; days supplied
  1.  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)
  1.  D SETMFILL^VPSOBJ(OREF,MFILL)
  1.  N NXFILLDT S NXFILLDT=$S(FLD(NAME,7,"I")]"":$$FMTE^XLFDT(FLD(NAME,7,"I"),2),1:"")  ; DATE NEXT FILLED
  1.  D SETNFILL^VPSOBJ(OREF,NXFILLDT)
  1.  D SETRMLOC^VPSOBJ(OREF,FLD(NAME,3,"E")) ; remote fill location
  1.  D SETREMOT^VPSOBJ(OREF,FLD(NAME,9,"E")]"") ; remote med id exist
  1.  N MARKFOL S MARKFOL=FLD(NAME,16,"I") ; mark for follow-up for patient facilitated output
  1.  I STAFF,MARKFOL]"" S MARKFOL=">>" D SETMKFOL^VPSOBJ(OREF,MARKFOL)
  1.  D SETPATRP^VPSOBJ(OREF,FLD(NAME,11,"E")) ; MR preset patient response
  1.  Q
  1.  ;
  1. NAMELINE(OREF) ; Add followup, patient response, med name to result array
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N MARKFOL S MARKFOL=$$GETMKFOL^VPSOBJ(OREF)
  1.  N PATRESP S PATRESP=$$GETPATRP^VPSOBJ(OREF)
  1.  N NAME S NAME=$$GETMEDNM^VPSOBJ(OREF)
  1.  ;
  1.  N VPSX S VPSX=""
  1.  I STAFF S VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP"))
  1.  S VPSX=$$SETFLD^VPSPUTL1(PATRESP,VPSX,COL("PATRESP"))
  1.  S VPSX=$$SETFLD^VPSPUTL1(NAME,VPSX,COL("MEDNAME"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. SIGLINES(OREF) ; Add SIG lines to result array
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N TYPE S TYPE=$$GETMTYPE^VPSOBJ(OREF)
  1.  N SIG S SIG(1)=$$GETSIG^VPSOBJ(OREF)
  1.  N LFTREFIL S LFTREFIL=$$GETLREFL^VPSOBJ(OREF)
  1.  N MAXREFIL S MAXREFIL=$$GETMREFL^VPSOBJ(OREF)
  1.  N NSIG S ^TMP("VPSPUTL1",$J)=0 D FCOMM^VPSPUTL1(.SIG,$P(COL("SIG"),U,2),.NSIG)
  1.  ;
  1.  N LAST S LAST=$O(NSIG(""),-1)
  1.  N SUB S SUB=0
  1.  ;
  1.  F  S SUB=$O(NSIG(SUB)) Q:'SUB  D
  1.  . N VPSX S VPSX=$$SETFLD^VPSPUTL1(NSIG(SUB),"",COL("SIG"))
  1.  . I SUB=LAST,TYPE'="NONVA" S VPSX=$$SETFLD^VPSPUTL1("Refills left: "_LFTREFIL_" of "_MAXREFIL,VPSX,COL("REFILLS"))
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. PRVLINES(OREF) ; Add provider lines
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N TYPE S TYPE=$$GETMTYPE^VPSOBJ(OREF)
  1.  N PROVIDER S PROVIDER=$$GETPROV^VPSOBJ(OREF)
  1.  N DAYSUPLY S DAYSUPLY=$$GETDSPLY^VPSOBJ(OREF)
  1.  N VPSX S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Provider: "_PROVIDER,VPSX,COL("PROVIDER"))
  1.  I TYPE'="NONVA" S VPSX=$$SETFLD^VPSPUTL1("Days supplied: "_DAYSUPLY,VPSX,COL("DAYS SUPPLIED"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. PTCLINES(OREF) ; Add patient comments 
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N REMOTE S REMOTE=$$GETREMOT^VPSOBJ(OREF)
  1.  I REMOTE D ADDREMOT(OREF)
  1.  I 'REMOTE D ADDLOCAL(OREF)
  1.  Q 
  1.  ;
  1. ADDNONVA(OREF) ; Add Non-va patient comment
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
  1.  ; 
  1.  I $D(PATCOMM) D
  1.  . N RSS S RSS=0
  1.  . F  S RSS=$O(PATCOMM(RSS)) Q:'RSS  D
  1.  . . S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
  1.  . . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  D ADDBLANK^VPSOBJ(OREF)  ; add a blank line between medication sets
  1.  Q
  1.  ;
  1. ADDREMOT(OREF) ; Add remote (cdw) patient comment, filled days, next fill date to result array
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N REMLOC S REMLOC=$$GETRMLOC^VPSOBJ(OREF) ; remote location
  1.  N FILLED S FILLED=$$GETMFILL^VPSOBJ(OREF) ; how long in days the medication was filled
  1.  N NXFILLDT S NXFILLDT=$$GETNFILL^VPSOBJ(OREF) ; Next Fill Date
  1.  N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
  1.  N MEDTYPE S MEDTYPE=$$GETMTYPE^VPSOBJ(OREF) ; "ACTIVE", "NONVA", "PAST" Medication
  1.  ;
  1.  N VPSX S VPSX=""
  1.  S VPSX=$$SETFLD^VPSPUTL1("Remote: "_REMLOC,VPSX,COL("REMOTE"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  N RSS S RSS=0
  1.  N FIRST S FIRST=1
  1.  ;
  1.  F  S RSS=$O(PATCOMM(RSS)) Q:'RSS  D
  1.  . S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
  1.  . I TYPE'="PAST",FIRST S VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")),FIRST=0
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  I '$D(PATCOMM),TYPE'="PAST" D
  1.  . S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL"))
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. ADDLOCAL(OREF) ; Add local vista patient comment, filled days, next fill date to result array
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;
  1.  N VPSX S VPSX=""
  1.  N RSS S RSS=0
  1.  N NEXTFILL S NEXTFILL=0
  1.  N FIRST S FIRST=1
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N FILLED S FILLED=$$GETMFILL^VPSOBJ(OREF) ; how long in days the medication was filled
  1.  N NXFILLDT S NXFILLDT=$$GETNFILL^VPSOBJ(OREF) ; Next Fill Date
  1.  N PATCOMM D GETPATCM^VPSOBJ(OREF,.PATCOMM) ; Patient comments
  1.  N MEDTYPE S MEDTYPE=$$GETMTYPE^VPSOBJ(OREF) ; "ACTIVE", "NONVA", "PAST" Medication
  1.  ;
  1.  F  S RSS=$O(PATCOMM(RSS)) Q:'RSS  D
  1.  . S VPSX="",VPSX=$$SETFLD^VPSPUTL1(PATCOMM(RSS),VPSX,COL("COMMENTS"))
  1.  . I FIRST S VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED")) D ADDPDO^VPSOBJ(OREF,VPSX) S FIRST=0 Q
  1.  . I TYPE'="PAST",'FIRST,'NEXTFILL S VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")),NEXTFILL=1
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  I '$D(PATCOMM) D
  1.  . S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Filled: "_FILLED_"d ago",VPSX,COL("FILLED"))
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  I TYPE="ACTIVE",'NEXTFILL S VPSX="",VPSX=$$SETFLD^VPSPUTL1("Next est fill: "_NXFILLDT,VPSX,COL("NEXTFILL")) D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  D ADDBLANK^VPSOBJ(OREF)  ; add a blank line between medication sets
  1.  Q