VAQUPD25.m

VAQUPD25 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-93

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

EXTARR(TRAN,SEG,ROOT,OFFSET) ;PULL EXTRACTION ARRAY OUT OF DATA FILE

 ;INPUT  : TRAN - Pointer to VAQ - TRANSACTION file

 ;         SEG - Pointer to VAQ - DATA SEGMENT file

 ;         ROOT - Where to store the extraction array (full global ref)

 ;         OFFSET - Where to begin placing information (defaults to 0)

 ;                  (Only valid for extractions that are in Display

 ;                   Ready format)

 ;OUTPUT : 0 - Success (non-display ready)

 ;         n - Number of lines in display (display ready format)

 ;        -1^Error_Text - Error

 ;NOTES  : If the segment is not in display ready format

 ;           ROOT("VALUE",File,Field,Seq)=Data

 ;           ROOT("ID",File,Field,Seq)=Identifier

 ;         If the segment is in display ready format

 ;           ROOT("DISPLAY",LineNumber,0)=Line of display

 ;

 ;CHECK INPUT

 S TRAN=+$G(TRAN)

 S SEG=+$G(SEG)

 Q:(('TRAN)!('SEG)) "-1^Did not pass pointer transaction or segment"

 S OFFSET=+$G(OFFSET)

 Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid transaction"

 Q:('$D(^VAT(394.71,SEG))) "-1^Did not pass a valid segment"

 Q:($G(ROOT)="") "-1^Did not pass reference to output array"

 ;DON'T EXTRACT IF PURGE FLAG IS SET

 Q:($D(^VAT(394.61,"PURGE",1,TRAN))) "-1^Transaction has been flagged for purging"

 ;DECLARE VARIABLES

 N LINE,IFN,TMP,SEQ,FILE,FIELD,VALUE,ID,DISPLAY

 S LINE=OFFSET

 ;DETERMINE IF SEGMENT HAS DATA

 Q:('$D(^VAT(394.62,"A-SEGMENT",TRAN,SEG))) "-1^Segment did not contain any data"

 ;DETERMINE IF SEGMENT IS DISPLAY READY

 S DISPLAY=$D(^VAT(394.62,"A-DISPLAY",TRAN,SEG))

 ;DISPLAY READY

 I (DISPLAY) D  Q LINE-OFFSET

 .;GET IFN (USED FOR DIPSLAY READY)

 .S IFN=+$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,""))

 .Q:('IFN)

 .S SEQ=0

 .F  S SEQ=$O(^VAT(394.62,IFN,"DSP",SEQ)) Q:('SEQ)  D

 ..S VALUE=$G(^VAT(394.62,IFN,"DSP",SEQ,0))

 ..S @ROOT@("DISPLAY",LINE,0)=VALUE

 ..S LINE=LINE+1

 ;EXTRACTION ARRAY

 S IFN=""

 F  S IFN=$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,IFN)) Q:('IFN)  D

 .S TMP=$G(^VAT(394.62,IFN,0))

 .S FILE=+$P(TMP,"^",3)

 .Q:('FILE)

 .S FIELD=+$P(TMP,"^",4)

 .Q:('FIELD)

 .S SEQ=+$G(^VAT(394.62,IFN,"SQNCE"))

 .S VALUE=$G(^VAT(394.62,IFN,"VAL"))

 .S ID=$G(^VAT(394.62,IFN,"IDNT1"))

 .S @ROOT@("VALUE",FILE,FIELD,SEQ)=VALUE

 .S @ROOT@("ID",FILE,FIELD,SEQ)=ID

 Q 0

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQUPD25   2415     printed  Apr 09, 2024@21:28:05                                                                                                                                                                                                    Page 2

VAQUPD25  ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-93

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

EXTARR(TRAN,SEG,ROOT,OFFSET) ;PULL EXTRACTION ARRAY OUT OF DATA FILE

 +1       ;INPUT  : TRAN - Pointer to VAQ - TRANSACTION file

 +2       ;         SEG - Pointer to VAQ - DATA SEGMENT file

 +3       ;         ROOT - Where to store the extraction array (full global ref)

 +4       ;         OFFSET - Where to begin placing information (defaults to 0)

 +5       ;                  (Only valid for extractions that are in Display

 +6       ;                   Ready format)

 +7       ;OUTPUT : 0 - Success (non-display ready)

 +8       ;         n - Number of lines in display (display ready format)

 +9       ;        -1^Error_Text - Error

 +10      ;NOTES  : If the segment is not in display ready format

 +11      ;           ROOT("VALUE",File,Field,Seq)=Data

 +12      ;           ROOT("ID",File,Field,Seq)=Identifier

 +13      ;         If the segment is in display ready format

 +14      ;           ROOT("DISPLAY",LineNumber,0)=Line of display

 +15      ;

 +16      ;CHECK INPUT

 +17       SET TRAN=+$GET(TRAN)

 +18       SET SEG=+$GET(SEG)

 +19       if (('TRAN)!('SEG))

               QUIT "-1^Did not pass pointer transaction or segment"

 +20       SET OFFSET=+$GET(OFFSET)

 +21       if ('$DATA(^VAT(394.61,TRAN)))

               QUIT "-1^Did not pass valid transaction"

 +22       if ('$DATA(^VAT(394.71,SEG)))

               QUIT "-1^Did not pass a valid segment"

 +23       if ($GET(ROOT)="")

               QUIT "-1^Did not pass reference to output array"

 +24      ;DON'T EXTRACT IF PURGE FLAG IS SET

 +25       if ($DATA(^VAT(394.61,"PURGE",1,TRAN)))

               QUIT "-1^Transaction has been flagged for purging"

 +26      ;DECLARE VARIABLES

 +27       NEW LINE,IFN,TMP,SEQ,FILE,FIELD,VALUE,ID,DISPLAY

 +28       SET LINE=OFFSET

 +29      ;DETERMINE IF SEGMENT HAS DATA

 +30       if ('$DATA(^VAT(394.62,"A-SEGMENT",TRAN,SEG)))

               QUIT "-1^Segment did not contain any data"

 +31      ;DETERMINE IF SEGMENT IS DISPLAY READY

 +32       SET DISPLAY=$DATA(^VAT(394.62,"A-DISPLAY",TRAN,SEG))

 +33      ;DISPLAY READY

 +34       IF (DISPLAY)

               Begin DoDot:1

 +35      ;GET IFN (USED FOR DIPSLAY READY)

 +36               SET IFN=+$ORDER(^VAT(394.62,"A-SEGMENT",TRAN,SEG,""))

 +37               if ('IFN)

                       QUIT 

 +38               SET SEQ=0

 +39               FOR 

                       SET SEQ=$ORDER(^VAT(394.62,IFN,"DSP",SEQ))

                       if ('SEQ)

                           QUIT 

                       Begin DoDot:2

 +40                       SET VALUE=$GET(^VAT(394.62,IFN,"DSP",SEQ,0))

 +41                       SET @ROOT@("DISPLAY",LINE,0)=VALUE

 +42                       SET LINE=LINE+1

                       End DoDot:2

               End DoDot:1

               QUIT LINE-OFFSET

 +43      ;EXTRACTION ARRAY

 +44       SET IFN=""

 +45       FOR 

               SET IFN=$ORDER(^VAT(394.62,"A-SEGMENT",TRAN,SEG,IFN))

               if ('IFN)

                   QUIT 

               Begin DoDot:1

 +46               SET TMP=$GET(^VAT(394.62,IFN,0))

 +47               SET FILE=+$PIECE(TMP,"^",3)

 +48               if ('FILE)

                       QUIT 

 +49               SET FIELD=+$PIECE(TMP,"^",4)

 +50               if ('FIELD)

                       QUIT 

 +51               SET SEQ=+$GET(^VAT(394.62,IFN,"SQNCE"))

 +52               SET VALUE=$GET(^VAT(394.62,IFN,"VAL"))

 +53               SET ID=$GET(^VAT(394.62,IFN,"IDNT1"))

 +54               SET @ROOT@("VALUE",FILE,FIELD,SEQ)=VALUE

 +55               SET @ROOT@("ID",FILE,FIELD,SEQ)=ID

               End DoDot:1

 +56       QUIT 0