source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADS01.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1VAQADS01 ;ALB/JRP - SYSTEM ADMINISTRATION;27-MAY-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3WORKDONE(WORKID,TRANS,DONEBY) ;LOG WORK DONE USING PDX
4 ;INPUT : WORKID - Identifier for type of work done
5 ; TRANS - Transaction work was done with (pointer)
6 ; DONEBY - Person that did the work (pointer)
7 ; (if NULL, assumes PDX Server)
8 ;OUTPUT : 0 - Work was successfully logged or reported
9 ; -1^Error_Text - Error
10 ;
11 ;CHECK INPUT
12 Q:('$D(WORKID)) "-1^Did not pass work identifier"
13 Q:('$D(TRANS)) "-1^Did not pass transaction work was done with"
14 Q:(('TRANS)!('$D(^VAT(394.61,TRANS)))) "-1^Did not pass a valid transaction"
15 S DONEBY=+$G(DONEBY)
16 ;DECLARE VARIABLES
17 N TMP,IFN,NAME,SSN,PID,SITE,DOMAIN,SEGMENT
18 N DATETIME,PATIENT,DIC,X,DD,DO,Y
19 S TMP="^NEW^RJCT^RLSE^RQST^SEND^SNSTVE^UNKN^UNQE^UPDTE^"
20 Q:(TMP'[("^"_WORKID_"^")) "-1^Did not pass a valid word identifier"
21 S DATETIME=$$NOW^VAQUTL99(1,0)
22 Q:($P(DATETIME,"^",1)="-1") "-1^Could not create entry in work-load file"
23 ;CHANGE DUZ INTO A VALID NAME (USE NULL FOR PDX SERVER)
24 S:(DONEBY=.5) DONEBY=0
25 S DONEBY=$P($G(^VA(200,DONEBY,0)),"^",1)
26 S:((DONEBY="")!(DONEBY="POSTMASTER")) DONEBY=""
27 ;GET PATIENT INFORMATION
28 S PATIENT=+$P($G(^VAT(394.61,TRANS,0)),"^",3)
29 S:('$D(^DPT(PATIENT))) PATIENT=0
30 S TMP=$G(^VAT(394.61,TRANS,"QRY"))
31 S NAME=$P(TMP,"^",1)
32 S SSN=$P(TMP,"^",2)
33 S PID=$P(TMP,"^",4)
34 ;DETERMINE REMOTE SITE & DOMAIN
35 S (SITE,DOMAIN)=""
36 I ((WORKID="RJCT")!(WORKID="RLSE")!(WORKID="SEND")!(WORKID="UNKN")!(WORKID="UNQE")) D
37 .S TMP=$G(^VAT(394.61,TRANS,"RQST2"))
38 .S SITE=$P(TMP,"^",1)
39 .S DOMAIN=$P(TMP,"^",2)
40 I ((WORKID="NEW")!(WORKID="RQST")!(WORKID="UPDTE")) D
41 .S TMP=$G(^VAT(394.61,TRANS,"ATHR2"))
42 .S SITE=$P(TMP,"^",1)
43 .S DOMAIN=$P(TMP,"^",2)
44 I (WORKID="SNSTVE") D
45 .S TMP=$G(^VAT(394.61,TRANS,"ATHR2"))
46 .S SITE=$P(TMP,"^",1)
47 .S DOMAIN=$P(TMP,"^",2)
48 ;CREATE ENTRY IN WORK-LOAD FILE
49 S DIC="^VAT(394.87,"
50 S X=DATETIME
51 S DIC("DR")=""
52 S DIC(0)="L"
53 D FILE^DICN
54 S IFN=+Y
55 Q:(IFN<0) "-1^Unable to create entry in work-load file"
56 ;PUT IN KNOWN INFORMATION
57 S Y=$$FILEINFO^VAQFILE(394.87,IFN,.02,DONEBY)
58 S Y=$$FILEINFO^VAQFILE(394.87,IFN,.03,WORKID)
59 S:(PATIENT) Y=$$FILEINFO^VAQFILE(394.87,IFN,10,PATIENT)
60 S Y=$$FILEINFO^VAQFILE(394.87,IFN,11,NAME)
61 S Y=$$FILEINFO^VAQFILE(394.87,IFN,12,SSN)
62 S Y=$$FILEINFO^VAQFILE(394.87,IFN,13,PID)
63 S Y=$$FILEINFO^VAQFILE(394.87,IFN,20,SITE)
64 S Y=$$FILEINFO^VAQFILE(394.87,IFN,21,DOMAIN)
65 ;PUT IN SEGMENTS
66 S TMP=0
67 F S TMP=+$O(^VAT(394.61,TRANS,"SEG",TMP)) Q:('TMP) D
68 .S X=+$G(^VAT(394.61,TRANS,"SEG",TMP,0))
69 .Q:('X)
70 .S SEGMENT=$P($G(^VAT(394.71,X,0)),"^",1)
71 .Q:(SEGMENT="")
72 .S X=$$FILEINFO^VAQFILE(394.87,IFN,30,SEGMENT,.01,SEGMENT)
73 Q 0
Note: See TracBrowser for help on using the repository browser.