- 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 Feb 18, 2025@23:50:35 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
