| [613] | 1 | VAQADS01 ;ALB/JRP - SYSTEM ADMINISTRATION;27-MAY-93 | 
|---|
|  | 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993 | 
|---|
|  | 3 | WORKDONE(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 | 
|---|