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