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

VPSPDO2.m

Go to the documentation of this file. 
  1. VPSPDO2 ;DALOI/KML,WOIFO/BT -  PDO OUTPUT DISPLAY - ALLERGIES (Continue);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.  ;
  1. BLDADD(OREF) ; build additional allergies section for Patient Entered allergy medication review note
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  D ADDCJ^VPSOBJ(OREF,"Patient-entered allergy reactions/comments")
  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 VPSX S VPSX=""
  1.  N ALRID,ALRIEN S (ALRID,ALRIEN)=0
  1.  ;
  1.  F  S ALRID=$O(^VPS(853.5,PTIEN,"MRAR",LASTMRAR,"ALLERGYADD","B",ALRID)) Q:'ALRID  F  S ALRIEN=$O(^(ALRID,ALRIEN)) Q:'ALRIEN  D
  1.  . D INTADDAL(OREF,ALRIEN) ; initialize additional allergy info
  1.  . D PREPCOM(OREF) ; prepare additional allergies comments to build
  1.  . I 'HDR S HDR=1 D ADDADHDR(OREF) ; build additional allergy header
  1.  . D ADDADALR(OREF) ; build additional allergy items
  1.  . D ADDBLANK^VPSOBJ(OREF)  ; add a blank line between each additional allergies
  1.  ;
  1.  D ADDBLANK^VPSOBJ(OREF)  ; add a blank line between additional allergies and next section
  1.  Q 
  1.  ; 
  1. INTADDAL(OREF,ALRIEN) ; initialize additional allergy info
  1.  ; INPUT
  1.  ;   OREF   : Object Reference for the VPS PDO object
  1.  ;   ALRIEN : Additional 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.  N ADALRVT S ADALRVT=$$GET1^DIQ(853.53,ALRIEN_","_LASTMRAR_","_PTIEN_",",1,"","ADALRVT") ; Additional allergy entered by the patient
  1.  D SETADDVT^VPSOBJ(OREF,.ADALRVT)
  1.  K ADALRVT
  1.  ;
  1.  N ADALRPR S ADALRPR=$$GET1^DIQ(853.53,ALRIEN_","_LASTMRAR_","_PTIEN_",",1.5,"","ADALRPR") ; Additional allergy typed in by provider
  1.  D SETADDPR^VPSOBJ(OREF,.ADALRPR)
  1.  K ADALRPR
  1.  ;
  1.  N ADDREACT S ADDREACT=$$GET1^DIQ(853.53,ALRIEN_","_LASTMRAR_","_PTIEN_",",2) ; REACTION to the additional allergy typed in by the provider (staff-facing)
  1.  D SETADRCT^VPSOBJ(OREF,ADDREACT)
  1.  ;
  1.  I STAFF D
  1.  . N MARKFOL S MARKFOL=$S($$GET1^DIQ(853.53,ALRIEN_","_LASTMRAR_","_PTIEN_",",4)]"":">>",1:"")  ; mark for follow-up for patient facilitated output
  1.  . D SETADDMF^VPSOBJ(OREF,MARKFOL)
  1.  Q
  1.  ;
  1. PREPCOM(OREF) ; prepare additional allergies comments to build
  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.  ;
  1.  I 'STAFF D  ; prepare additional veteran comment
  1.  . N ALRVET D GETADDVT^VPSOBJ(OREF,.ALRVET)
  1.  . Q:$G(ALRVET)']""
  1.  . S ^TMP("VPSPUTL1",$J)=0
  1.  . N FALRVET D FCOMM^VPSPUTL1(.ALRVET,$P(COL("ADDALLERGY-VET"),U,2),.FALRVET)
  1.  . N DONTKNOW S DONTKNOW=$$GETDKNW^VPSOBJ(OREF)
  1.  . N FDONTKNW
  1.  . I DONTKNOW]"" S DONTKNOW(1)=" ;"_DONTKNOW D FCOMM^VPSPUTL1(.DONTKNOW,$P(COL("ADDALLERGY-VET"),U,2),.FDONTKNW)
  1.  . N TEMP M TEMP=FALRVET,TEMP=FDONTKNW
  1.  . S ^TMP("VPSPUTL1",$J)=0
  1.  . N ADDCOMM D FCOMM^VPSPUTL1(.TEMP,$P(COL("ADDALLERGY-VET"),U,2),.ADDCOMM)
  1.  . D SETADDFV^VPSOBJ(OREF,.ADDCOMM)
  1.  . K FALRVET,FDONTKNOW,ALRVET,ADDCOMM
  1.  ;
  1.  I STAFF D  ; prepare additional comment by provider
  1.  . N ALRPR D GETADDPR^VPSOBJ(OREF,.ALRPR)
  1.  . I $G(ALRPR)]"" D
  1.  . . S ^TMP("VPSPUTL1",$J)=0
  1.  . . N FALRPR D FCOMM^VPSPUTL1(.ALRPR,$P(COL("ALLERNM"),U,2),.FALRPR)
  1.  . . D SETADDFP^VPSOBJ(OREF,.FALRPR)
  1.  . . K FALRPR
  1.  . ;
  1.  . N ADDREACT S ADDREACT=$$GETADRCT^VPSOBJ(OREF)
  1.  . I ADDREACT]"" D
  1.  . . S ADDREACT(1)=ADDREACT
  1.  . . S ^TMP("VPSPUTL1",$J)=0
  1.  . . N FADDRCT D FCOMM^VPSPUTL1(.ADDREACT,$P(COL("REACTION"),U,2),.FADDRCT)
  1.  . . D SETADDFR^VPSOBJ(OREF,.FADDRCT)
  1.  . . K FADDRCT
  1.  Q
  1.  ;
  1. ADDADHDR(OREF) ; build additional allergy header
  1.  ; INPUT
  1.  ;   OREF : Object Reference for the VPS PDO object
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N VPSX S VPSX=""
  1.  S VPSX=$$SETFLD^VPSPUTL1("Name",VPSX,COL("ALLERNM"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Reaction",VPSX,COL("REACTION"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. ADDADALR(OREF) ; build additional allergy items
  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.  ;
  1.  I 'STAFF D
  1.  . N ADDCOMM D GETADDFV^VPSOBJ(OREF,.ADDCOMM)
  1.  . N VPSX S VPSX=""
  1.  . N RSS S RSS=0
  1.  . F  S RSS=$O(ADDCOMM(RSS)) Q:'RSS  D
  1.  . . S VPSX=$$SETFLD^VPSPUTL1(ADDCOMM(RSS),VPSX,COL("ADDALLERGY-VET"))
  1.  . . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  I STAFF D
  1.  . N ADDCOMM D GETADDFP^VPSOBJ(OREF,.ADDCOMM)
  1.  . N REACT D GETADDFR^VPSOBJ(OREF,.REACT)
  1.  . N MARKFOL S MARKFOL=0
  1.  . N VPSX S VPSX=""
  1.  . N RSS S RSS=0
  1.  . F  S RSS=$O(ADDCOMM(RSS)) Q:'RSS  D
  1.  . . I RSS=1 D
  1.  . . . S MARKFOL=$$GETADDMF^VPSOBJ(OREF)
  1.  . . . S VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP"))
  1.  . . S VPSX=$$SETFLD^VPSPUTL1(ADDCOMM(RSS),VPSX,COL("ALLERNM"))
  1.  . . S VPSX=$$SETFLD^VPSPUTL1($G(REACT(RSS)),VPSX,COL("REACTION"))
  1.  . . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  . ;build the rest of reaction incase reaction lines are longer than allergy lines
  1.  . S RSS=$O(ADDCOMM(""),-1)
  1.  . S VPSX=""
  1.  . F  S RSS=$O(REACT(RSS)) Q:'RSS  D
  1.  . . S VPSX=$$SETFLD^VPSPUTL1(MARKFOL,VPSX,COL("FOLLOWUP"))
  1.  . . S VPSX=$$SETFLD^VPSPUTL1($G(REACT(RSS)),VPSX,COL("REACTION"))
  1.  . . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ;
  1. GETCH(OREF) ;retrieve any changes to allergy profile since last MRAR
  1.  ; ICR 5843 - Controlled Subscription for read of PATIENT ALLERGIES file (120.8)
  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 ALLITMS D GETALLR^VPSOBJ(OREF,.ALLITMS)
  1.  ;
  1.  N HDR S HDR=0
  1.  N VPSX S VPSX=""
  1.  N VDA S VDA=0
  1.  ;
  1.  F  S VDA=$O(^GMR(120.8,"B",PTIEN,VDA)) Q:'VDA  D
  1.  . Q:LASTMRAR>+$$GET1^DIQ(120.8,VDA_",",20,"I")  ; if VPS trxn date/time is greater than what is stored in patient allergy profile then not a changed or added allergy so skip this allergy entry
  1.  . Q:+$$GET1^DIQ(120.8,VDA_",",21,"I")=0   ; if VERIFIED BY is not populated do not display the allergy
  1.  . ;
  1.  . ; -- get the newly entered allergy
  1.  . N ANAME S ANAME=$$GET1^DIQ(120.8,VDA_",",.02)
  1.  . ;
  1.  . ; -- set action
  1.  . N ENTERR S ENTERR=+$$GET1^DIQ(120.8,VDA_",",22,"I") ;entered in error
  1.  . N ACTION
  1.  . I '$D(ALLITMS(ANAME)) S ACTION=$S(ENTERR:"Deleted",1:"Added")
  1.  . I $D(ALLITMS(ANAME)) S ACTION=$S(ENTERR:"Deleted",1:"Changed")
  1.  . ;
  1.  . ; -- get reactions
  1.  . N REACTION
  1.  . N VIEN S VIEN=0
  1.  . N SEQ S SEQ=0
  1.  . F  S VIEN=$O(^GMR(120.8,VDA,10,VIEN)) Q:'VIEN  D
  1.  . . N VIENS S VIENS=VIEN_","_VDA_","
  1.  . . S SEQ=SEQ+1,REACTION(SEQ)=$$GET1^DIQ(120.81,VIENS,".01")
  1.  . ;
  1.  . ; build allergies changes
  1.  . I 'HDR S HDR=1 D ADDCHGHD(OREF)
  1.  . D ADDCHG(OREF,ANAME,.REACTION,ACTION)
  1.  . D ADDBLANK^VPSOBJ(OREF)  ; add a blank line between allergy sets with multiple reactions
  1.  Q
  1.  ;
  1. ADDCHGHD(OREF) ; build allergies changes header
  1.  D ADDCJ^VPSOBJ(OREF,"*** CHANGES TO ALLERGIES SINCE MRAR LAST COMPLETED ***")
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N VPSX S VPSX=""
  1.  S VPSX=$$SETFLD^VPSPUTL1("Name",VPSX,COL("ALLERNM"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Reaction",VPSX,COL("REACTION"))
  1.  S VPSX=$$SETFLD^VPSPUTL1("Action",VPSX,COL("ACTION"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q
  1.  ; 
  1. ADDCHG(OREF,ANAME,REACTION,ACTION) ; build allergies changes
  1.  ; INPUT
  1.  ;   OREF     : Object Reference for the VPS PDO object
  1.  ;   ANAME    : newly entered Allergy name
  1.  ;   REACTION : array of reactions of the allergy
  1.  ;   ACTION   : what to do with the reaction review
  1.  ;
  1.  N COL D GETFORMT^VPSOBJ(OREF,.COL)
  1.  N VPSX S VPSX=""
  1.  S VPSX=$$SETFLD^VPSPUTL1(ANAME,VPSX,COL("ALLERNM"))
  1.  S VPSX=$$SETFLD^VPSPUTL1(REACTION(1),VPSX,COL("REACTION"))
  1.  S VPSX=$$SETFLD^VPSPUTL1(ACTION,VPSX,COL("ACTION"))
  1.  D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  ;
  1.  N RSS S RSS=1
  1.  S VPSX=""
  1.  F  S RSS=$O(REACTION(RSS)) Q:'RSS  D
  1.  . S VPSX=$$SETFLD^VPSPUTL1(REACTION(RSS),VPSX,COL("REACTION"))
  1.  . D ADDPDO^VPSOBJ(OREF,VPSX)
  1.  Q