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

VPSALL01.m

Go to the documentation of this file. 
  1. VPSALL01 ;DALOI/KML - Retrieve Allergies for Vetlink ;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.  ; ICR 3449 - Controlled Subscription for read of ADVERSE REACTION ASSESSMENT file (120.86)
  1.  ; ICR 5843 - Controlled Subscription for read of PATIENT ALLERGIES file (120.8)
  1.  ;
  1. GET(VPSRES,VPSDFN) ;
  1.  ;RPC = VPS GET ALLERGIES
  1.  ; Return allergies for patient VPSDFN
  1.  ; 
  1.  ; INPUT  - VPSRES - 1st parameter required by RPC Broker; represents output
  1.  ;          VPSDFN - IEN of PATIENT file
  1.  ;
  1.  ; OUTPUT - VPSRES - returns results of procedure which is the data taken from the entry in file 120.8
  1.  ;
  1.  K VPSRES,ALST
  1.  I '+$G(VPSDFN) S VPSRES(0)="99^PATIENT DFN not sent" Q
  1.  I '$D(^DPT(VPSDFN)) S VPSRES(0)="99^PATIENT not in VistA database" Q
  1.  N VPSRA S VPSRA=$$GET1^DIQ(120.86,VPSDFN,1,"I")
  1.  I 'VPSRA S VPSRES(0)="0^NO ALLERGIES OR NO ASSESSMENT" Q
  1.  N VDA,VIEN,VIENS,DDFLDS,VCTR
  1.  S (VDA,VIEN)=0
  1.  S VCTR=1
  1.  D TABLE(.DDFLDS)
  1.  F  S VDA=$O(^GMR(120.8,"B",VPSDFN,VDA)) Q:'VDA  D
  1.  . D GETS^DIQ(120.8,VDA_",",".01;.02;1;4;5;22;23;24","IE","ALST")
  1.  . S VIENS=VDA_","
  1.  . D BLDRES(120.8,VIENS,.ALST,.DDFLDS,.VCTR,.VPSRES)
  1.  . S VIEN=0
  1.  . F  S VIEN=$O(^GMR(120.8,VDA,10,VIEN)) Q:'VIEN  D
  1.  . . S VIENS=VIEN_","_VDA_","
  1.  . . D GETS^DIQ(120.81,VIENS,".01;1","IE","ALST")
  1.  . . D BLDRES(120.81,VIENS,.ALST,.DDFLDS,.VCTR,.VPSRES)
  1.  . S VIEN=0
  1.  . F  S VIEN=$O(^GMR(120.8,VDA,26,VIEN)) Q:'VIEN  D
  1.  . . S VIENS=VIEN_","_VDA_","
  1.  . . D GETS^DIQ(120.826,VIENS,".01;1;1.5;2","IE","ALST")
  1.  . . D BLDRES(120.826,VIENS,.ALST,.DDFLDS,.VCTR,.VPSRES)
  1.  I '$D(VPSRES) S VPSRES(0)="0^NO ALLERGIES FOR THIS PATIENT" Q
  1.  Q
  1.  ;
  1. BLDRES(VFL,IENS,ALST,DDFLDS,CTR,RESULTS) ;
  1.  ; build allergy results array that gets returned to client
  1.  ; the results consist of allergy data taken from the entry at 120.8 and associated multiples (sub-entries)
  1.  ; 
  1.  ; INPUT
  1.  ;   VFL     - file number
  1.  ;   IENS    - internal entry numbers for top entries and any sub-entries
  1.  ;   ALST    - contains the data taken from the fields existing at the entry and sub-entries of 120.8 (built from GETS^DIQ)
  1.  ;   DDFLDS  - array of fields defined in 120.8
  1.  ;   CTR     - Sequential numeric value that is assigned as the subscript to the local results array, passed in by reference
  1.  ;   RESULTS - passed in by reference
  1.  ;   
  1.  ; OUTPUT
  1.  ;   RESULTS - array of patient allergies taken from specified fields in the patient entry in 120.8
  1.  ;   Each subscript in the array is assigned a composite, delimited string as described in the next comment:
  1.  ;   RESULTS(ctr)="file name^iens (top file, subfile)^field number^field name^data value"
  1.  ;
  1.  N I,Y,VFLD,VSTR,VINEX,VFNAME,N,TRMIEN
  1.  S VFLD=0
  1.  F  S VFLD=$O(ALST(VFL,IENS,VFLD)) Q:'VFLD  D
  1.  . S TRMIEN=$S($P(IENS,",",2)']"":$P(IENS,","),$P(IENS,",",3)']"":$P(IENS,",",1,2),1:IENS)
  1.  . S VSTR=DDFLDS(VFL,VFLD)
  1.  . S VINEX=$P(DDFLDS(VFL,VFLD),U,2)  ; internal or external value
  1.  . S VFNAME=$P(DDFLDS(VFL,VFLD),U)  ; field name
  1.  . I VINEX="IE" D  Q  ; for fields that need to return both internal and external values
  1.  . . F I="I","E" Q:ALST(VFL,IENS,VFLD,I)']""  S Y=$S(I="I":" IEN",1:" NAME"),RESULTS(CTR)=VFL_U_TRMIEN_U_VFLD_U_VFNAME_Y_U_ALST(VFL,IENS,VFLD,I),CTR=CTR+1
  1.  . I VINEX="WP" D  Q  ; word processing field (comments)
  1.   . . S N=0 F  S N=$O(ALST(VFL,IENS,VFLD,N)) Q:'N  Q:ALST(VFL,IENS,VFLD,N)']""  S RESULTS(CTR)=VFL_U_TRMIEN_U_VFLD_U_VFNAME_U_ALST(VFL,IENS,VFLD,N),CTR=CTR+1
  1.  . Q:ALST(VFL,IENS,VFLD,VINEX)']""
  1.  . S RESULTS(CTR)=VFL_U_TRMIEN_U_VFLD_U_VFNAME_U_ALST(VFL,IENS,VFLD,VINEX)
  1.  . S CTR=CTR+1
  1.  Q
  1.  ;
  1. TABLE(DEFS) ;the DD field array built at this procedure will be used when constructing the allergy results array
  1.  ;input/output - DEFS passed in by reference
  1.  ; example of what gets built:
  1.  ; DEFS(120.8,.01)="PATIENT^I"
  1.  ; DEFS(120.8,.02)="REACTANT^E"
  1.  ; DEFS(120.8,1)="GMR ALLERGY^I"
  1.  N LN,LINE,STRING
  1.  F LN=3:1 S LINE=$T(AFLDS+LN),STRING=$P(LINE,";;",2) Q:STRING=""  S DEFS($P(STRING,U,1),$P(STRING,U,2))=$P(STRING,U,3)_U_$P(STRING,U,4)
  1.  Q
  1. AFLDS ; valid fields defined in the PATIENT ALLERGIES file (120.8)
  1.  ; negotiated fields to be given to kiosk for MRAR event or for the purposes of tiu note during PDO invocable period 
  1.  ;;FILE NUMBER^FIELD NUMBER^FIELD NAME^INTERNAL/EXTERNAL VALUE
  1.  ;;120.8^.01^PATIENT^I^
  1.  ;;120.8^.02^REACTANT^E
  1.  ;;120.8^1^GMR ALLERGY^I
  1.  ;;120.8^4^ORIGINATION DATE/TIME^I
  1.  ;;120.8^5^ORIGINATOR^E
  1.  ;;120.8^22^ENTERED IN ERROR^E
  1.  ;;120.8^23^DATE/TIME ENTERED IN ERROR^I
  1.  ;;120.8^24^USER ENTERING IN ERROR^E
  1.  ;;120.81^.01^REACTION^IE
  1.  ;;120.81^1^OTHER REACTION^E
  1.  ;;120.826^.01^DATE/TIME COMMENT ENTERED^I
  1.  ;;120.826^1^USER ENTERING^E
  1.  ;;120.826^1.5^COMMENT TYPE^E
  1.  ;;120.826^2^COMMENTS^WP