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

VAQDBIP.m

Go to the documentation of this file.
  1. VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. EXTRACT(TRAN,DFN,SEGMENT,ARRAY,OFFSET) ;EXTRACTIONS BY PDX
  1. ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
  1. ; DFN - Pointer to patient in PATIENT file
  1. ; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
  1. ; ARRAY - Where to store information (full global reference)
  1. ; OFFSET - Where to start adding lines (defaults to 0)
  1. ; Only used for Display Ready extract
  1. ;OUTPUT : n - Number of lines in display
  1. ; -1^Error_Text - Error
  1. ;NOTES : If TRAN is passed
  1. ; The patient pointer of the transaction will be used
  1. ; Encryption will be based on the transaction
  1. ; If DFN is passed
  1. ; Encryption will be based on the site parameter
  1. ; : Pointer to transaction takes precedence over DFN ... if
  1. ; TRAN>0 the DFN will be based on the transaction
  1. ;
  1. ;CHECK INPUT
  1. S TRAN=+$G(TRAN)
  1. S DFN=+$G(DFN)
  1. Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
  1. I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
  1. I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
  1. Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
  1. Q:('$G(SEGMENT)) "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
  1. Q:($G(ARRAY)="") "-1^Did not pass output array"
  1. S OFFSET=+$G(OFFSET)
  1. ;DECLARE VARIABLES
  1. N TMP,SEG
  1. ;GET SEGMENT ABBREVIATION
  1. S SEG=$P($G(^VAT(394.71,SEGMENT,0)),"^",2)
  1. Q:(SEG="") "-1^Segment pointer not valid"
  1. ;MEANS TEST SEGMENT
  1. Q:(SEG="PDX*MT") $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
  1. ;PDX MINIMUM PATIENT INFO SEGMENT
  1. Q:(SEG="PDX*MIN") $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
  1. ;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
  1. Q:(SEG="PDX*MPL") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
  1. ;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
  1. Q:(SEG="PDX*MPS") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
  1. ;PDX MAS (REGISTRATION) INFO SEGMENT
  1. Q:(SEG="PDX*MAS") $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
  1. ;SEGMENT NOT EXTRACTED BY THIS ROUTINE
  1. Q "-1^Extraction of segment not supported"
  1. ;
  1. GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
  1. ;INPUT : ARR - Where information is being stored (full global ref)
  1. ; FLE - File [number] containing information
  1. ; FLD - Field [number] where data is stored
  1. ;OUTPUT : Next sequence number in extraction array
  1. ;
  1. N SEQ
  1. F SEQ=0:1 Q:('$D(@ARR@("VALUE",FLE,FLD,SEQ)))
  1. Q SEQ