source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPST23.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

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