VAQDBIP.m

VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93

 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

EXTRACT(TRAN,DFN,SEGMENT,ARRAY,OFFSET) ;EXTRACTIONS BY PDX

 ;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 ---VAQDBIP   2587     printed  Apr 09, 2024@21:28:47                                                                                                                                                                                                     Page 2

VAQDBIP   ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93

 +1       ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993

EXTRACT(TRAN,DFN,SEGMENT,ARRAY,OFFSET) ;EXTRACTIONS BY PDX

 +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