- VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- ; DFN - Pointer to patient in PATIENT file
- ; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
- ; ARRAY - Where to store information (full global reference)
- ; OFFSET - Where to start adding lines (defaults to 0)
- ; Only used for Display Ready extract
- ;OUTPUT : n - Number of lines in display
- ; -1^Error_Text - Error
- ;NOTES : If TRAN is passed
- ; The patient pointer of the transaction will be used
- ; Encryption will be based on the transaction
- ; If DFN is passed
- ; Encryption will be based on the site parameter
- ; : Pointer to transaction takes precedence over DFN ... if
- ; TRAN>0 the DFN will be based on the transaction
- ;
- ;CHECK INPUT
- S TRAN=+$G(TRAN)
- S DFN=+$G(DFN)
- Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
- I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
- I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
- Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
- Q:('$G(SEGMENT)) "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
- Q:($G(ARRAY)="") "-1^Did not pass output array"
- S OFFSET=+$G(OFFSET)
- ;DECLARE VARIABLES
- N TMP,SEG
- ;GET SEGMENT ABBREVIATION
- S SEG=$P($G(^VAT(394.71,SEGMENT,0)),"^",2)
- Q:(SEG="") "-1^Segment pointer not valid"
- ;MEANS TEST SEGMENT
- Q:(SEG="PDX*MT") $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
- ;PDX MINIMUM PATIENT INFO SEGMENT
- Q:(SEG="PDX*MIN") $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
- ;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
- Q:(SEG="PDX*MPL") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
- ;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
- Q:(SEG="PDX*MPS") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
- ;PDX MAS (REGISTRATION) INFO SEGMENT
- Q:(SEG="PDX*MAS") $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
- ;SEGMENT NOT EXTRACTED BY THIS ROUTINE
- Q "-1^Extraction of segment not supported"
- ;
- GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
- ;INPUT : ARR - Where information is being stored (full global ref)
- ; FLE - File [number] containing information
- ; FLD - Field [number] where data is stored
- ;OUTPUT : Next sequence number in extraction array
- ;
- N SEQ
- F SEQ=0:1 Q:('$D(@ARR@("VALUE",FLE,FLD,SEQ)))
- Q SEQ
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIP 2587 printed Feb 18, 2025@23:51:10 Page 2
- VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- +1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- +2 ; DFN - Pointer to patient in PATIENT file
- +3 ; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
- +4 ; ARRAY - Where to store information (full global reference)
- +5 ; OFFSET - Where to start adding lines (defaults to 0)
- +6 ; Only used for Display Ready extract
- +7 ;OUTPUT : n - Number of lines in display
- +8 ; -1^Error_Text - Error
- +9 ;NOTES : If TRAN is passed
- +10 ; The patient pointer of the transaction will be used
- +11 ; Encryption will be based on the transaction
- +12 ; If DFN is passed
- +13 ; Encryption will be based on the site parameter
- +14 ; : Pointer to transaction takes precedence over DFN ... if
- +15 ; TRAN>0 the DFN will be based on the transaction
- +16 ;
- +17 ;CHECK INPUT
- +18 SET TRAN=+$GET(TRAN)
- +19 SET DFN=+$GET(DFN)
- +20 if (('TRAN)&('DFN))
- QUIT "-1^Did not pass pointer to transaction or patient"
- +21 IF (TRAN)
- if ('$DATA(^VAT(394.61,TRAN)))
- QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
- +22 IF (TRAN)
- SET DFN=+$PIECE($GET(^VAT(394.61,TRAN,0)),"^",3)
- if ('DFN)
- QUIT "-1^Transaction did not contain pointer to PATIENT file"
- +23 if ('$DATA(^DPT(DFN)))
- QUIT "-1^Did not pass valid pointer to PATIENT file"
- +24 if ('$GET(SEGMENT))
- QUIT "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
- +25 if ($GET(ARRAY)="")
- QUIT "-1^Did not pass output array"
- +26 SET OFFSET=+$GET(OFFSET)
- +27 ;DECLARE VARIABLES
- +28 NEW TMP,SEG
- +29 ;GET SEGMENT ABBREVIATION
- +30 SET SEG=$PIECE($GET(^VAT(394.71,SEGMENT,0)),"^",2)
- +31 if (SEG="")
- QUIT "-1^Segment pointer not valid"
- +32 ;MEANS TEST SEGMENT
- +33 if (SEG="PDX*MT")
- QUIT $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
- +34 ;PDX MINIMUM PATIENT INFO SEGMENT
- +35 if (SEG="PDX*MIN")
- QUIT $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
- +36 ;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
- +37 if (SEG="PDX*MPL")
- QUIT $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
- +38 ;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
- +39 if (SEG="PDX*MPS")
- QUIT $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
- +40 ;PDX MAS (REGISTRATION) INFO SEGMENT
- +41 if (SEG="PDX*MAS")
- QUIT $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
- +42 ;SEGMENT NOT EXTRACTED BY THIS ROUTINE
- +43 QUIT "-1^Extraction of segment not supported"
- +44 ;
- GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
- +1 ;INPUT : ARR - Where information is being stored (full global ref)
- +2 ; FLE - File [number] containing information
- +3 ; FLD - Field [number] where data is stored
- +4 ;OUTPUT : Next sequence number in extraction array
- +5 ;
- +6 NEW SEQ
- +7 FOR SEQ=0:1
- if ('$DATA(@ARR@("VALUE",FLE,FLD,SEQ)))
- QUIT
- +8 QUIT SEQ