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

VPSPDO1.m

Go to the documentation of this file. 
  1. VPSPDO1 ;DALOI/KML,WOIFO/BT -  PDO OUTPUT DISPLAY - ALLERGIES ;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 VPSPDO* procedures produce 2 separate displays of the PDO output 
  1.  ; which are the  PATIENT ENTERED ALLERGY MEDICATION REVIEW and the PATIENT FACILITATED 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.  ; the GET procedure below determines which version of the PDO output to display
  1.  ;
  1. GET(PDO,VPSNUM,VPSTYP) ; RPC: VPS GET MRAR PDO
  1.  ; INPUT
  1.  ;   PDO    : the name of global array where each line of the MRAR output will be stored  (e.g., "^TMP(""VPSPDO1"",$J)"
  1.  ;   VPSNUM : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
  1.  ;   VPSTYP : Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
  1.  ; OUTPUT
  1.  ;   PDO    : the name of global array where each line of the MRAR output will be stored
  1.  ;
  1.  ;Store Displayed MRAR data into global array PDO
  1.  S PDO=$NA(^TMP("VPSPDO1",$J))
  1.  K @PDO
  1.  S VPSNUM=$G(VPSNUM)
  1.  S VPSTYP=$G(VPSTYP)
  1.  N VPSDFN S VPSDFN=$$VALIDATE^VPSRPC1(VPSTYP,VPSNUM)
  1.  I VPSDFN<1 S @PDO@(1,0)=$P(VPSDFN,U,2)
  1.  I VPSDFN>0 D GETPDO(VPSDFN,PDO)
  1.  Q
  1.  ;
  1. TIU(PTIEN,PDOARY) ;TIU DOCUMENT: |VPS MRAR PDO|
  1.  ; TIU OBJECT : S X=$$TIU^VPSPDO1(DFN,"^TMP(""VPSPDO1"",$J)")
  1.  ;
  1.  ; INPUT
  1.  ;   PTIEN  : PATIENT DFN
  1.  ;   PDOARY : the name of global array where each line of the TIU will be stored
  1.  ;
  1.  ;Store Displayed MRAR data into global array where the name is assigned to PDOARY (eg: "^TMP(""VPSPDO1"",$J)")
  1.  D GETPDO(PTIEN,PDOARY)
  1.  Q "~@"_$NA(@PDOARY)
  1.  ;
  1. GETPDO(PTIEN,PDOARY) ;
  1.  ; INPUT
  1.  ;   PTIEN  : PATIENT DFN
  1.  ;   PDOARY : the name of global array where each line of the TIU will be stored
  1.  ;
  1.  ; -- create VPS pdo object
  1.  N PDOOREF S PDOOREF=$$NEW^VPSOBJ(PTIEN,PDOARY)
  1.  ;
  1.  ; -- initialize PDO object with date of Last Mrar and Staff flag
  1.  Q:'$$INITPDO(PDOOREF)
  1.  ;
  1.  ; -- Okay to Invoke PDO ?
  1.  Q:'$$OKINVK(PDOOREF)
  1.  ; 
  1.  ; -- date/time stamp the PDO FIRST INVOKED or PDO INVOKED DT field
  1.  Q:'$$UPDINVK(PDOOREF,$$NOW^XLFDT())
  1.  ;
  1.  ; -- Generate PDO in temp global
  1.  D START(PDOOREF)
  1.  ;
  1.  ; -- clean up PDO object
  1.  D CLOSE^VPSOBJ(PDOOREF)
  1.  Q
  1.  ;
  1. INITPDO(OREF) ; initialize PDO object with date of LAST MRAR, STAFF flag
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ; RETURN
  1.  ;   1 if successfull otherwise 0
  1.  ;
  1.  ; -- validate patient MRAR
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  I 'PTIEN D SETERR^VPSOBJ(OREF,"Invalid Patient IEN") Q 0
  1.  I '$D(^VPS(853.5,PTIEN)) D SETERR^VPSOBJ(OREF,"This patient has no MRAR data.") Q 0
  1.  ;
  1.  N LASTMRAR S LASTMRAR=$O(^VPS(853.5,PTIEN,"MRAR","B",""),-1)
  1.  I 'LASTMRAR D SETERR^VPSOBJ(OREF,"This patient has no MRAR transaction.") Q 0
  1.  ;
  1.  ; -- set last mrar
  1.  D SETLSTMR^VPSOBJ(OREF,LASTMRAR)
  1.  ;
  1.  ; -- If field .13 (Interface module = "S" then data comes from staff-facing interfacing otherwise from patient-facing (kiosk))
  1.  N STAFF S STAFF=$S($$GET1^DIQ(853.51,LASTMRAR_","_PTIEN_",",.13,"I")="S":1,1:0)
  1.  D SETSTAFF^VPSOBJ(OREF,STAFF)
  1.  ;
  1.  Q (LASTMRAR>0)
  1.  ;
  1. OKINVK(OREF) ;Okay to Invoke PDO ?
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ; RETURN
  1.  ;   1 if successfull otherwise 0
  1.  ;
  1.  ; -- get the PDO invocable period
  1.  N PERIOD S PERIOD=$$GETINVPR(OREF)
  1.  Q:'PERIOD 0
  1.  ;
  1.  ; -- how old is the last mrar
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  N TRNDT S TRNDT=$$DT^XLFDT() ; IA #10103
  1.  N AGE S AGE=$$FMDIFF^XLFDT(TRNDT,$P(LASTMRAR,"."),1)
  1.  ;
  1.  ; -- okay if the last mrar in the invocable period
  1.  Q 1
  1.  N OK S OK=(AGE'>PERIOD)
  1.  I 'OK D SETERR^VPSOBJ(OREF,"The last MRAR for this patient is too old. Last MRAR Date = "_$$FMTE^XLFDT(LASTMRAR,5)_". PDO Invocable Period = "_PERIOD)
  1.  Q OK
  1.  ;
  1. GETINVPR(OREF) ;get the PDO invocable period
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ; RETURN
  1.  ;   PDO invocable period if successfull otherwise 0
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ; -- Check make sure last mrar transaction contain either Kiosk Group or Clinic.
  1.  ;    These values will be used to retrieve the invocable period in file 853
  1.  N KIOSKGRP S KIOSKGRP=$$GET1^DIQ(853.51,LASTMRAR_","_PTIEN_",",.03,"I")
  1.  N CLINIC S CLINIC=$$GET1^DIQ(853.51,LASTMRAR_","_PTIEN_",",.04,"I")
  1.  N NOREQFLD S NOREQFLD=(KIOSKGRP="")&(CLINIC="")
  1.  I NOREQFLD D SETERR^VPSOBJ(OREF,"The last MRAR for this patient has undefined Kiosk Group and undefined Clinic. Either Kiosk Group or Clinic must exist")
  1.  Q:NOREQFLD 0
  1.  ;
  1.  ; -- Get invocable period based on Kiosk Group and/or CLinic
  1.  N KGPER,KGTRXDT S KGPER=$$GETPER("D",KIOSKGRP,.KGTRXDT)
  1.  N CLPER,CLTRXDT S CLPER=$$GETPER("C",CLINIC,.CLTRXDT)
  1.  ;
  1.  ; -- Get the period that was set last (most current)
  1.  N PERIOD S PERIOD=$S(KGTRXDT>CLTRXDT:KGPER,1:CLPER)
  1.  S:'PERIOD PERIOD=3 ; default is 3 days
  1.  Q PERIOD
  1.  ;
  1. GETPER(IDX,VAL,PRMTRXDT) ;Get invocable period based on Kiosk Group and/or CLinic
  1.  ; INPUT
  1.  ;   IDX      : Index name to get the IEN of Kiosk Group or Clinic in File 853
  1.  ;   VAL      : either the Kiosk group or the Clinic IEN
  1.  ; OUTPUT
  1.  ;   PRMTRXDT : The last transaction date in file 853 that contains Invocable period
  1.  ; RETURN
  1.  ;   Invocable Period
  1.  ;
  1.  S PRMTRXDT=0
  1.  N PERIOD S PERIOD=0
  1.  ; KDC 10/31/2014
  1.  I IDX=""!(VAL="") Q PERIOD
  1.  N PRMIEN S PRMIEN=$O(^VPS(853,IDX,VAL,0))
  1.  Q:'PRMIEN PERIOD
  1.  ;
  1.  S PRMTRXDT=99999999
  1.  F  S PRMTRXDT=$O(^VPS(853,PRMIEN,"PARAM",PRMTRXDT),-1) Q:'PRMTRXDT  D  Q:PERIOD
  1.  . S PERIOD=$P($G(^VPS(853,PRMIEN,"PARAM",PRMTRXDT,1)),U)
  1.  S:PRMTRXDT=99999999 PRMTRXDT=0
  1.  Q PERIOD
  1.  ;
  1. UPDINVK(OREF,DTSTAMP) ;update the PDO FIRST INVOKED or PDO INVOKED DT field
  1.  ; INPUT
  1.  ;   OREF    : Object Reference for the VPS PDO object
  1.  ;   DTSTAMP : Date/Time Stamp the PDO FIRST INVOKED or PDO INVOKED DT field
  1.  ; RETURN
  1.  ;   1 if successfull otherwise 0
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  ; -- Get First Invoked Date
  1.  N FINVKDT S FINVKDT=$$GET1^DIQ(853.51,LASTMRAR_","_PTIEN_",",70,"I")
  1.  ;
  1.  ; -- if PDO FIRST INVOKED doesn't exist set it otherwise set the PDO NEXT INVOKED
  1.  N VPSFDA,VPSERR
  1.  I FINVKDT="" S VPSFDA(853.51,LASTMRAR_","_PTIEN_",",70)=DTSTAMP
  1.  I FINVKDT'="" S VPSFDA(853.51,LASTMRAR_","_PTIEN_",",73)=DTSTAMP
  1.  D FILE^DIE("","VPSFDA","VPSERR")
  1.  Q:'$D(VPSERR) 1
  1.  ;
  1.  ; -- filing error
  1.  N ERRNUM S ERRNUM=$O(VPSERR("DIERR",0))
  1.  D SETERR^VPSOBJ(OREF,VPSERR("DIERR",ERRNUM,"TEXT",1))
  1.  Q 0
  1.  ;
  1. START(OREF) ;allergy and medications section of the PDO output specifically for the PATIENT ENTERED ALLERGY MEDICATION REVIEW
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  ; -- Header lines
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  D HDR(OREF)
  1.  ;
  1.  ; -- Review conducted with lines
  1.  D:STAFF CNDWTH(OREF)
  1.  ;
  1.  ; -- Allergies section
  1.  D ADDCJ^VPSOBJ(OREF,"***   ALLERGIES   ***   ALLERGIES   ***")
  1.  D ALRLOCAL(OREF) ; build local vista allergy
  1.  D ALRREMTE(OREF) ; build remote (cdw) allergy
  1.  D ADDALLER(OREF) ; build additional allergy
  1.  D GETCH^VPSPDO2(OREF) ; build allergy changes since last mrar
  1.  ;
  1.  ; -- MEDICATIONS Section
  1.  N MEDITMS ; array represents the list of medications - built by MEDS and used by MEDCHNG to display only the changes
  1.  D MEDHDR^VPSPDO1M(OREF) ; build medication header section
  1.  D MEDS^VPSPDO1M(OREF,.MEDITMS) ; build medication section
  1.  D ADDMEDS^VPSPDO3M(OREF) ; build additional medication section
  1.  D MEDCHNG^VPSPDO2M(OREF,.MEDITMS) ; build Medication Changes Since section
  1.  Q
  1.  ; 
  1. HDR(OREF) ; produce TIU Note header lines
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N LMRARDT S LMRARDT=$$GETLSTMR^VPSOBJ(OREF)
  1.  I 'STAFF D ADDLJ^VPSOBJ(OREF,"Patient Entered Allergy Medication Review : "_$$FMTE^XLFDT(LMRARDT))
  1.  I STAFF D ADDLJ^VPSOBJ(OREF,"PATIENT FACILITATED ALLERGY MEDICATION REVIEW: "_$$FMTE^XLFDT(LMRARDT))
  1.  D ADDUNDLN^VPSOBJ(OREF)
  1.  Q
  1.  ;
  1. CNDWTH(OREF) ; produce Review conducted with lines
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  ; join conducted with items into a string
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  N STRING S STRING=""
  1.  N CNDWTH S CNDWTH=0
  1.  ;
  1.  F  S CNDWTH=$O(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"MRARWITH",CNDWTH)) Q:'CNDWTH  D
  1.  . S STRING=STRING_$$GET1^DIQ(853.5121,CNDWTH_","_LASTMRAR_","_PTIEN_",",.01,"E")_", "
  1.  S:STRING'="" STRING=$E(STRING,1,$L(STRING)-2)
  1.  ;
  1.  ; display conducted with line
  1.  D ADDLJ^VPSOBJ(OREF,"REVIEW CONDUCTED WITH: "_STRING)
  1.  D ADDUNDLN^VPSOBJ(OREF)
  1.  Q
  1.  ;
  1. ALRLOCAL(OREF) ;produce local allergy section
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  N BL F BL=1:1:2 D ADDBLANK^VPSOBJ(OREF)
  1.  N LOCAL S LOCAL=$D(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGY","LOCAL"))
  1.  I LOCAL D
  1.  . D ADDLJ^VPSOBJ(OREF,"Allergy Response Key")
  1.  . D ADDLJ^VPSOBJ(OREF,"Y = Allergic")
  1.  . D ADDLJ^VPSOBJ(OREF,"N = Not Allergic")
  1.  . D ADDLJ^VPSOBJ(OREF,"? = Unsure")
  1.  . D ADDLJ^VPSOBJ(OREF,"X = No Response (incomplete session/no answer)")
  1.  . N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  . I STAFF D ADDLJ^VPSOBJ(OREF,">> indicates MARK FOR FOLLOW UP")
  1.  . D ADDBLANK^VPSOBJ(OREF)
  1.  . D ADDCJ^VPSOBJ(OREF,"Local Allergies")
  1.  . D BLD(OREF,"LOCAL")
  1.  I 'LOCAL D
  1.  . D ADDCJ^VPSOBJ(OREF,"Local Allergies")
  1.  . D ADDLJ^VPSOBJ(OREF,"Patient has NKDA at this VA.")
  1.  Q
  1.  ;
  1. ALRREMTE(OREF) ; produce remote allergies section
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  D ADDBLANK^VPSOBJ(OREF)
  1.  D ADDCJ^VPSOBJ(OREF,"Remote Allergies")
  1.  N REMOTE S REMOTE=$D(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGY","REMOTE"))
  1.  I REMOTE D BLD(OREF,"REMOTE")
  1.  I 'REMOTE D 
  1.  . D ADDLJ^VPSOBJ(OREF,"Patient has NKDA at any remote VA.")
  1.  . D ADDBLANK^VPSOBJ(OREF)
  1.  Q
  1.  ;
  1. ADDALLER(OREF) ; build additional allergies section
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  ; 
  1.  N ALLRADD S ALLRADD=$D(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGYADD"))
  1.  N REMOTE S REMOTE=$D(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGY","REMOTE"))
  1.  N NKDA S NKDA=($$GET1^DIQ(853.51,LASTMRAR_","_PTIEN_",",20,"I"))
  1.  N DONTKNOW S DONTKNOW=$$GET1^DIQ(853.51,LASTMRAR_","_PTIEN,19)  ; patient could have also selected the structured response, "I don't know what my other allergies are". 
  1.  D SETDKNW^VPSOBJ(OREF,DONTKNOW)
  1.  ;
  1.  I ALLRADD D BLDADD^VPSPDO2(OREF) ; build additional allergies section
  1.  I STAFF,'ALLRADD,'REMOTE,NKDA D ADDLJ^VPSOBJ(OREF,"Patient has NKDA confirmed no additional allergies present.")
  1.  Q
  1.  ;
  1. BLD(OREF,TYPE) ;  build local and remote allergy sections for Patient Entered allergy medication review note
  1.  ; INPUT:
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;   TYPE : "LOCAL" or "REMOTE"
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  ;
  1.  N HDR S HDR=0
  1.  N NOALLER S NOALLER=1
  1.  N ALRID,ALRIEN S (ALRID,ALRIEN)=0
  1.  ;
  1.  F  S ALRID=$O(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGY",TYPE,ALRID)) Q:'ALRID  F  S ALRIEN=$O(^(ALRID,ALRIEN)) Q:'ALRIEN  D
  1.  . ; initialze object with allergy name, patient response, station, mark for followup
  1.  . Q:'$$ALLRFLD(OREF,TYPE,ALRIEN)  ; quit if allergy name is null (vecna needs to send a name)
  1.  . ;
  1.  . S NOALLER=0 ; indicate that there is allergy
  1.  . D BLDALR(OREF,ALRIEN,TYPE) ; build the allergy array to be used in CHANGES SINCE algorithm
  1.  . ;
  1.  . I 'HDR S HDR=1 D ADALHDR(OREF,TYPE) ; Add header for allergy items (do only once)
  1.  . D ADALFLDS(OREF,TYPE) ; add other allergy fields
  1.  ;
  1.  I NOALLER D
  1.  . I TYPE="LOCAL" D ADDLJ^VPSOBJ(OREF,"Patient has NKDA at this VA.")
  1.  . I TYPE'="LOCAL" D ADDLJ^VPSOBJ(OREF,"Patient has NKDA at any remote VA.")
  1.  Q
  1.  ; 
  1. ALLRFLD(OREF,TYPE,ALRIEN) ; Initialize allergy name, patient response, station, mark for followup
  1.  ; INPUT
  1.  ;   OREF   : Object Reference for the VPS PDO object
  1.  ;   TYPE   : Type of Allergy data(LOCAL VISTA /REMOTE - CDW)
  1.  ;   ALRIEN : Allergy IEN
  1.  ;
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  ;
  1.  ; -- Initialize allergy name
  1.  N ALLRNM
  1.  I TYPE="LOCAL" D
  1.  . S ALLRNM=$$GET1^DIQ(853.52,ALRIEN_","_LASTMRAR_","_PTIEN_",",.02,"I")
  1.  . S ALLRNM=$$GET1^DIQ(120.8,ALLRNM_",",.02,"E") ; LOCAL ALLERGY ID
  1.  I TYPE'="LOCAL" S ALLRNM=$$GET1^DIQ(853.52,ALRIEN_","_LASTMRAR_","_PTIEN_",",.05) ; REMOTE ALLERGY NAME
  1.  Q:ALLRNM="" 0  ; quit if allergy name is null (vecna needs to send a name)
  1.  D SETALRNM^VPSOBJ(OREF,ALLRNM)
  1.  ;
  1.  ; -- Initialize Patient Response
  1.  N PATRESP S PATRESP=$$GET1^DIQ(853.52,ALRIEN_","_LASTMRAR_","_PTIEN_",",.06,"I") ; PATIENT RESPONSE which could be "YES", "NO", "NOT SURE", "NO RESPONSE"
  1.  S PATRESP=$S(PATRESP="U":"?",1:PATRESP)
  1.  D SETPATRP^VPSOBJ(OREF,PATRESP)
  1.  ;
  1.  ; -- Initialize Station
  1.  N STATION S STATION=$$GET1^DIQ(853.52,ALRIEN_","_LASTMRAR_","_PTIEN_",",.09,"E")
  1.  D SETSTATN^VPSOBJ(OREF,STATION)
  1.  ;
  1.  ; -- Initialize Mark for follow-up
  1.  N MARKFOL S MARKFOL=""
  1.  I STAFF S MARKFOL=$S($$GET1^DIQ(853.52,ALRIEN_","_LASTMRAR_","_PTIEN_",",16)]"":">>",1:"")  ; mark for follow-up for patient facilitated output
  1.  D SETMKFOL^VPSOBJ(OREF,MARKFOL)
  1.  Q 1
  1.  ;
  1. BLDALR(OREF,ALRIEN,TYPE) ; build the allergy array to be used in CHANGES SINCE algorithm
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;   ALRIEN   : Allergy IEN in File 853.52
  1.  ;   TYPE     : Type of Allergy data(LOCAL VISTA /REMOTE - CDW)
  1.  ;
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N PTIEN S PTIEN=$$GETDFN^VPSOBJ(OREF)
  1.  N LASTMRAR S LASTMRAR=$$GETLSTMR^VPSOBJ(OREF)
  1.  N ALLRNM S ALLRNM=$$GETALRNM^VPSOBJ(OREF) ;Allergy Name must exist before calling this procedure, caller will validate
  1.  ;
  1.  N ALLRITMS,REACT
  1.  S ALLRITMS(ALLRNM)=""
  1.  N REACTIEN S REACTIEN=0
  1.  ;
  1.  F  S REACTIEN=$O(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGY",ALRIEN,"REACTIONS",REACTIEN)) Q:'REACTIEN  D
  1.  . S REACT(REACTIEN)=$$GETREACT(TYPE,REACTIEN,ALRIEN,LASTMRAR,PTIEN)_" " ; get reaction name
  1.  . S ALLRITMS(ALLRNM,REACTIEN)=REACT(REACTIEN)
  1.  ;
  1.  I $D(ALLRITMS(ALLRNM)) D  ; pull reaction info for this allergy
  1.  . N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  . N REACTLN D REACT^VPSPUTL1(STAFF,LASTMRAR,PTIEN,ALRIEN,.COL,.REACT,.REACTLN)
  1.  . M ALLRITMS(ALLRNM,"REACTLN")=REACTLN
  1.  . K REACTLN
  1.  ; 
  1.  D SETALLR^VPSOBJ(OREF,.ALLRITMS)
  1.  K ALLRITMS
  1.  Q
  1.  ;
  1. GETREACT(TYPE,REACTIEN,ALRIEN,LASTMRAR,PTIEN) ; get reaction name
  1.  ; INPUT
  1.  ;   TYPE     : Type of Allergy data(LOCAL VISTA /REMOTE - CDW)
  1.  ;   REACTIEN : Allergy Reaction IEN in File 853.57
  1.  ;   ALRIEN   : Allergy IEN in File 853.52
  1.  ;   LASTMRAR : Date of Last MRAR
  1.  ;   PTIEN    : Patient DFN
  1.  ;
  1.  N IENS S IENS=REACTIEN_","_ALRIEN_","_LASTMRAR_","_PTIEN_","
  1.  N REACTNM S REACTNM=""
  1.  I TYPE="LOCAL" S REACTNM=$$GET1^DIQ(853.57,IENS,.02,"E")
  1.  I TYPE'="LOCAL" S REACTNM=$$GET1^DIQ(853.57,IENS,.04)
  1.  Q REACTNM
  1.  ;
  1. ADALHDR(OREF,TYPE) ; Add header for allergy items (do only once)
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;   TYPE : Type of Allergy data(LOCAL VISTA /REMOTE - CDW)
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N VPSX S VPSX=""
  1.  S VPSX=$$SETFLD^VPSPUTL1("",VPSX,COL("PATRESP"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Name",VPSX,COL("ALLERNM"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Reaction",VPSX,COL("REACTION"))
  1.  I TYPE="REMOTE" S VPSX=$$SETFLD^VPSPUTL1("Site",VPSX,COL("SITE"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. ADALFLDS(OREF,TYPE) ; add other allergy fields
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;   TYPE : Type of Allergy data(LOCAL VISTA /REMOTE - CDW)
  1.  ;
  1.  N STAFF S STAFF=$$GETSTAFF^VPSOBJ(OREF)
  1.  N ALRNM S ALRNM=$$GETALRNM^VPSOBJ(OREF)
  1.  N PATRESP S PATRESP=$$GETPATRP^VPSOBJ(OREF)
  1.  N STATION S STATION=$$GETSTATN^VPSOBJ(OREF)
  1.  N MARKFOL S MARKFOL=$$GETMKFOL^VPSOBJ(OREF)
  1.  N ALLR D GETALLR^VPSOBJ(OREF,.ALLR)
  1.  N REACTLN M REACTLN=ALLR(ALRNM,"REACTLN")
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  ;
  1.  N VPSX S VPSX=""
  1.  I STAFF S VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP")) ; include MARK FOR FOLLOW-UP indicator only for staff-facing output  
  1.  I STAFF S VPSX=$$SETFLD^VPSPUTL1(PATRESP,VPSX,COL("PATRESP")) ; include patient structured response in both remote and local allergy sections for staff-facing output  
  1.  I 'STAFF,TYPE="LOCAL" S VPSX=$$SETFLD^VPSPUTL1(PATRESP,VPSX,COL("PATRESP")) ; only include patient structured response for local allergy section for patient-facing output
  1.  S VPSX=$$SETFLD^VPSPUTL1(ALRNM,VPSX,COL("ALLERNM"))
  1.  S VPSX=$$SETFLD^VPSPUTL1($G(REACTLN(1)),VPSX,COL("REACTION"))
  1.  I TYPE="REMOTE" S VPSX=$$SETFLD^VPSPUTL1(STATION,VPSX,COL("SITE"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  ; -- Add rest of reaction list
  1.  N RSS S RSS=1
  1.  S VPSX=""
  1.  F  S RSS=$O(REACTLN(RSS)) Q:'RSS  D
  1.  . S VPSX=$$SETFLD^VPSPUTL1(REACTLN(RSS),VPSX,COL("REACTION"))
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  D ADDBLANK^VPSOBJ(OREF) ; add a blank line between allergy sets
  1.  Q
  1.  ;
  1.  ; Health Summary entry point
  1. HS ;
  1.  N TARGET,I
  1.  S TARGET="^TMP(""VPSPDO1"",$J)"
  1.  S I=$$TIU(DFN,TARGET)
  1.  S I=0
  1.  F  S I=$O(@TARGET@(I)) Q:'I  W !,@TARGET@(I,0)
  1.  W !!
  1.  S GMTSQIT=""
  1.  Q