| [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
 | 
|---|