VAQPST23 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
RESULTS(CORARR,DEBUG) ;CONVERT RESULTS OF REQUEST & UNSOLICITED PDXs
;INPUT : CORARR - Where correlation of 1.0 request with it's
; entry in 394.61 is stored (full global reference)
; DEBUG - Turns on debug mode (info written to screen)
; 1 - Debug on
; 0 - Debug off (default)
;OUTPUT : X - Number of requests successfully converted
; -1^Error_Text - Error (nothing converted)
;NOTES : CORARR will be in the format
; CORARR(X,Y)=Z
; X = 1.0 request number
; Y = 1.5 request number
; Z = 1.5 IFN
;
;CHECK INPUT
S CORARR=$G(CORARR)
Q:(CORARR="") "-1^Did not pass reference to correlation array"
S DEBUG=+$G(DEBUG)
;DECLARE VARIABLES
N AMBGPTR,NTFNPTR,REJPTR,CNTPTR,RSLTPTR,NTRGPTR,UNSPTR
N COUNT,ERRCNT,PTR10,STATUS,NODE0,NODE1,TMP,TRAN10,TRAN15
N LINE,PREPAR,BLOCK,XMER,TYPE,PTR15
;DETERMIN CONSTANTS
S PREPAR="^TMP(""VAQ-CNVRT"","_$J_")"
K @PREPAR
S AMBGPTR=+$O(^VAT(394.3,"B",11,""))
Q:('AMBGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 11 (ambiguous)"
S NTFNPTR=+$O(^VAT(394.3,"B",12,""))
Q:('NTFNPTR) "-1^PDX STATUS file (#394.3) did not contain status # 12 (not found)"
S REJPTR=+$O(^VAT(394.3,"B",13,""))
Q:('REJPTR) "-1^PDX STATUS file (#394.3) did not contain status # 13 (rejected)"
S CNTPTR=+$O(^VAT(394.3,"B",14,""))
Q:('CNTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 14 (contact facility)"
S RSLTPTR=+$O(^VAT(394.3,"B",15,""))
Q:('RSLTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 15 (results)"
S UNSPTR=+$O(^VAT(394.3,"B",16,""))
Q:('UNSPTR) "-1^PDX STATUS file (#394.3) did not contain status # 16 (Unsolicited PDX)"
S NTRGPTR=+$O(^VAT(394.3,"B",18,""))
Q:('NTRGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 18 (not registered)"
W:(DEBUG) !!!!
W:(DEBUG) !,"*********************"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"* PDX Result & *"
W:(DEBUG) !,"* Unsolicited PDX *"
W:(DEBUG) !,"* Conversion *"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"*********************"
W:(DEBUG) !!,"Pointer Information"
W:(DEBUG) !,"-------------------"
W:(DEBUG) !,"Ambiguous Pointer: ",AMBGPTR
W:(DEBUG) !,"Not Found Pointer: ",NTFNPTR
W:(DEBUG) !,"Rejected Pointer: ",REJPTR
W:(DEBUG) !,"Contact Facility Pointer: ",CNTPTR
W:(DEBUG) !,"Results Pointer: ",RSLTPTR
W:(DEBUG) !,"Not Registered Pointer: ",NTRGPTR
W:(DEBUG) !,"Unsolicited PDX Pointer: ",UNSPTR
;FILE RESULTS
W:(DEBUG) !!,"Converting results",!," Time: ",$$NOW^VAQUTL99,!
S COUNT=0
S ERRCNT=0
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",AMBGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",AMBGPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",NTFNPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTFNPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",REJPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",REJPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",CNTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",CNTPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",RSLTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",RSLTPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",NTRGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTRGPTR,PTR10)
;FILE UNSOLICITED PDXS
W:(DEBUG) !!,"Converting Unsolicited PDXs",!," Time: ",$$NOW^VAQUTL99,!
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",UNSPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",UNSPTR,PTR10)
K @PREPAR
Q (COUNT-ERRCNT)
;
FILE ;FILE REQUESTS
;INCREMENT COUNT
S COUNT=COUNT+1
I (DEBUG) W:(('(COUNT#5))&(COUNT#100)) "." W:('(COUNT#100)) "#"
;GET INFO FROM 1.0 TRANSACTION
I ('$D(^VAT(394,PTR10))) S ERRCNT=ERRCNT+1 Q
S NODE0=$G(^VAT(394,PTR10,0))
S NODE1=$G(^VAT(394,PTR10,1))
S TRAN10=+$P(NODE0,"^",2)
I ('TRAN10) S ERRCNT=ERRCNT+1 Q
S STATUS=+$P(NODE0,"^",12)
I ((STATUS'=AMBGPTR)&(STATUS'=NTFNPTR)&(STATUS'=REJPTR)&(STATUS'=CNTPTR)&(STATUS'=RSLTPTR)&(STATUS'=NTRGPTR)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
;CONVERT PARENT TRANSACTION NUMBER
S TMP=+$P(NODE0,"^",3)
S PARENT=+$O(@CORARR@(TMP,""))
I (('PARENT)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
S:(STATUS'=UNSPTR) $P(NODE0,"^",3)=PARENT
;GO TO CONTINUATION ROUTINE
D CNVRT1^VAQPST25
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST23 4407 printed Sep 23, 2025@20:02:10 Page 2
VAQPST23 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
RESULTS(CORARR,DEBUG) ;CONVERT RESULTS OF REQUEST & UNSOLICITED PDXs
+1 ;INPUT : CORARR - Where correlation of 1.0 request with it's
+2 ; entry in 394.61 is stored (full global reference)
+3 ; DEBUG - Turns on debug mode (info written to screen)
+4 ; 1 - Debug on
+5 ; 0 - Debug off (default)
+6 ;OUTPUT : X - Number of requests successfully converted
+7 ; -1^Error_Text - Error (nothing converted)
+8 ;NOTES : CORARR will be in the format
+9 ; CORARR(X,Y)=Z
+10 ; X = 1.0 request number
+11 ; Y = 1.5 request number
+12 ; Z = 1.5 IFN
+13 ;
+14 ;CHECK INPUT
+15 SET CORARR=$GET(CORARR)
+16 if (CORARR="")
QUIT "-1^Did not pass reference to correlation array"
+17 SET DEBUG=+$GET(DEBUG)
+18 ;DECLARE VARIABLES
+19 NEW AMBGPTR,NTFNPTR,REJPTR,CNTPTR,RSLTPTR,NTRGPTR,UNSPTR
+20 NEW COUNT,ERRCNT,PTR10,STATUS,NODE0,NODE1,TMP,TRAN10,TRAN15
+21 NEW LINE,PREPAR,BLOCK,XMER,TYPE,PTR15
+22 ;DETERMIN CONSTANTS
+23 SET PREPAR="^TMP(""VAQ-CNVRT"","_$JOB_")"
+24 KILL @PREPAR
+25 SET AMBGPTR=+$ORDER(^VAT(394.3,"B",11,""))
+26 if ('AMBGPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 11 (ambiguous)"
+27 SET NTFNPTR=+$ORDER(^VAT(394.3,"B",12,""))
+28 if ('NTFNPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 12 (not found)"
+29 SET REJPTR=+$ORDER(^VAT(394.3,"B",13,""))
+30 if ('REJPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 13 (rejected)"
+31 SET CNTPTR=+$ORDER(^VAT(394.3,"B",14,""))
+32 if ('CNTPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 14 (contact facility)"
+33 SET RSLTPTR=+$ORDER(^VAT(394.3,"B",15,""))
+34 if ('RSLTPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 15 (results)"
+35 SET UNSPTR=+$ORDER(^VAT(394.3,"B",16,""))
+36 if ('UNSPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 16 (Unsolicited PDX)"
+37 SET NTRGPTR=+$ORDER(^VAT(394.3,"B",18,""))
+38 if ('NTRGPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 18 (not registered)"
+39 if (DEBUG)
WRITE !!!!
+40 if (DEBUG)
WRITE !,"*********************"
+41 if (DEBUG)
WRITE !,"* *"
+42 if (DEBUG)
WRITE !,"* PDX Result & *"
+43 if (DEBUG)
WRITE !,"* Unsolicited PDX *"
+44 if (DEBUG)
WRITE !,"* Conversion *"
+45 if (DEBUG)
WRITE !,"* *"
+46 if (DEBUG)
WRITE !,"*********************"
+47 if (DEBUG)
WRITE !!,"Pointer Information"
+48 if (DEBUG)
WRITE !,"-------------------"
+49 if (DEBUG)
WRITE !,"Ambiguous Pointer: ",AMBGPTR
+50 if (DEBUG)
WRITE !,"Not Found Pointer: ",NTFNPTR
+51 if (DEBUG)
WRITE !,"Rejected Pointer: ",REJPTR
+52 if (DEBUG)
WRITE !,"Contact Facility Pointer: ",CNTPTR
+53 if (DEBUG)
WRITE !,"Results Pointer: ",RSLTPTR
+54 if (DEBUG)
WRITE !,"Not Registered Pointer: ",NTRGPTR
+55 if (DEBUG)
WRITE !,"Unsolicited PDX Pointer: ",UNSPTR
+56 ;FILE RESULTS
+57 if (DEBUG)
WRITE !!,"Converting results",!," Time: ",$$NOW^VAQUTL99,!
+58 SET COUNT=0
+59 SET ERRCNT=0
+60 SET PTR10=0
+61 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",AMBGPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",AMBGPTR,PTR10)
+62 SET PTR10=0
+63 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",NTFNPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",NTFNPTR,PTR10)
+64 SET PTR10=0
+65 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",REJPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",REJPTR,PTR10)
+66 SET PTR10=0
+67 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",CNTPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",CNTPTR,PTR10)
+68 SET PTR10=0
+69 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",RSLTPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",RSLTPTR,PTR10)
+70 SET PTR10=0
+71 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",NTRGPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",NTRGPTR,PTR10)
+72 ;FILE UNSOLICITED PDXS
+73 if (DEBUG)
WRITE !!,"Converting Unsolicited PDXs",!," Time: ",$$NOW^VAQUTL99,!
+74 SET PTR10=0
+75 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",UNSPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",UNSPTR,PTR10)
+76 KILL @PREPAR
+77 QUIT (COUNT-ERRCNT)
+78 ;
FILE ;FILE REQUESTS
+1 ;INCREMENT COUNT
+2 SET COUNT=COUNT+1
+3 IF (DEBUG)
if (('(COUNT#5))&(COUNT#100))
WRITE "."
if ('(COUNT#100))
WRITE "#"
+4 ;GET INFO FROM 1.0 TRANSACTION
+5 IF ('$DATA(^VAT(394,PTR10)))
SET ERRCNT=ERRCNT+1
QUIT
+6 SET NODE0=$GET(^VAT(394,PTR10,0))
+7 SET NODE1=$GET(^VAT(394,PTR10,1))
+8 SET TRAN10=+$PIECE(NODE0,"^",2)
+9 IF ('TRAN10)
SET ERRCNT=ERRCNT+1
QUIT
+10 SET STATUS=+$PIECE(NODE0,"^",12)
+11 IF ((STATUS'=AMBGPTR)&(STATUS'=NTFNPTR)&(STATUS'=REJPTR)&(STATUS'=CNTPTR)&(STATUS'=RSLTPTR)&(STATUS'=NTRGPTR)&(STATUS'=UNSPTR))
SET ERRCNT=ERRCNT+1
QUIT
+12 ;CONVERT PARENT TRANSACTION NUMBER
+13 SET TMP=+$PIECE(NODE0,"^",3)
+14 SET PARENT=+$ORDER(@CORARR@(TMP,""))
+15 IF (('PARENT)&(STATUS'=UNSPTR))
SET ERRCNT=ERRCNT+1
QUIT
+16 if (STATUS'=UNSPTR)
SET $PIECE(NODE0,"^",3)=PARENT
+17 ;GO TO CONTINUATION ROUTINE
+18 DO CNVRT1^VAQPST25
+19 QUIT
