source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPST22.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1VAQPST22 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3PROCESS(REMOTE,RETURN,DEBUG) ;CONVERT REMOTE REQUESTS
4 ;INPUT : REMOTE - Name of local site (used as authorizing site)
5 ; RETURN - Domain of local site (used as authorizing domain)
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 : All remote requests will be stored as requires manual
12 ; processing (even if they are marked for automatic)
13 ;
14 ;CHECK INPUT
15 S REMOTE=$G(REMOTE)
16 Q:(REMOTE="") "-1^Did not pass name of local site"
17 S RETURN=$G(RETURN)
18 Q:(RETURN="") "-1^Did not pass domain of local site"
19 S DEBUG=+$G(DEBUG)
20 N AUTOPTR,MANPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
21 N REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
22 N USER,SITE,PTR15,TRAN15,STATUS,DOMAIN
23 ;DETERMIN CONSTANTS
24 S AUTOPTR=+$O(^VAT(394.3,"B",20,""))
25 Q:('AUTOPTR) "-1^PDX STATUS file (#394.3) did not contain status # 20 (automatic processing)"
26 S MANPTR=+$O(^VAT(394.3,"B",17,""))
27 Q:('MANPTR) "-1^PDX STATUS file (#394.3) did not contain status # 17 (requires processing)"
28 W:(DEBUG) !!!!
29 W:(DEBUG) !,"*******************************"
30 W:(DEBUG) !,"* *"
31 W:(DEBUG) !,"* Remote Request Conversion *"
32 W:(DEBUG) !,"* *"
33 W:(DEBUG) !,"*******************************"
34 W:(DEBUG) !!,"Pointer Information"
35 W:(DEBUG) !,"-------------------"
36 W:(DEBUG) !,"Automatic Processing Pointer: ",AUTOPTR
37 W:(DEBUG) !,"Requires Processing Pointer: ",MANPTR
38 ;FILE REMOTE REQUESTS
39 W:(DEBUG) !!,"Converting remote requests ",!," Time: ",$$NOW^VAQUTL99,!
40 S COUNT=0
41 S ERRCNT=0
42 S PTR10=0
43 F S PTR10=+$O(^VAT(394,"AD",AUTOPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",AUTOPTR,PTR10)
44 S PTR10=0
45 F S PTR10=+$O(^VAT(394,"AD",MANPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",MANPTR,PTR10)
46 Q (COUNT-ERRCNT)
47 ;
48FILE ;FILE REQUESTS
49 ;INCREMENT COUNT
50 S COUNT=COUNT+1
51 I (DEBUG) W:(('(COUNT#5))&(COUNT#100)) "." W:('(COUNT#100)) "#"
52 ;GET INFO FROM 1.0 TRANSACTION
53 I ('$D(^VAT(394,PTR10))) S ERRCNT=ERRCNT+1 Q
54 S NODE0=$G(^VAT(394,PTR10,0))
55 S NODE1=$G(^VAT(394,PTR10,1))
56 S TRAN10=+$P(NODE0,"^",2)
57 I ('TRAN10) S ERRCNT=ERRCNT+1 Q
58 S TMP=+$P(NODE0,"^",12)
59 I ((TMP'=AUTOPTR)&(TMP'=MANPTR)) S ERRCNT=ERRCNT+1 Q
60 S STATUS="VAQ-PROC"
61 S PATPTR=$P(NODE0,"^",9)
62 S NAME=$P(NODE0,"^",4)
63 S DOB=$P(NODE0,"^",7)
64 S SSN=$P(NODE0,"^",5)
65 S PID=$S(SSN="":"",1:($E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)))
66 I (PATPTR="") S:(SSN'="") PATPTR=$O(^DPT("SSN",SSN,""))
67 S DATE=$P(NODE0,"^",1)
68 S USER=$P(NODE0,"^",19)
69 S SITE=$P(NODE0,"^",17)
70 I (SITE) D
71 .S TMP=+$O(^DIC(4,"D",SITE,""))
72 .Q:('TMP)
73 .S SITE=$P($G(^DIC(4,TMP,0)),"^",1)
74 .S:(SITE="") SITE=$P(NODE0,"^",17)
75 S DOMAIN=$P(NODE1,"^",1)
76 I (DOMAIN="") S ERRCNT=ERRCNT+1 Q
77 S REMTRAN=$P(NODE0,"^",3)
78 S RELEASE="VAQ-RQACK"
79 ;GO TO CONTINUATION ROUTINE
80 D CNVRT^VAQPST24
81 Q
Note: See TracBrowser for help on using the repository browser.