VIABRPC3 ;AAC/PB - VIA RPCs ;10/06/2016
;;1.0;VISTA INTEGRATION ADAPTER;**9,20**;06-FEB-2014;Build 5
;Per VA Directive 6402, this routine should not be modified.
;Reference to ^SC( supported by IA 10040
;Reference to XPAR APIS supported by IA 2263
;Reference to PSSP51P supported by IA 4546
;Reference to ^LAB(61 supported by IA 2388
;Reference to $$VALID^LR7OV4 supported by IA 2429#
; supported ICRs below.
;Reference to ^%DTC supported by IA # 10003
;Reference to $$FIND1^DIC supported by IA #2051
;Reference to GETS^DIQ supported by IA 2056#
;Reference to ^XLFDT supported by IA #10103
;Reference to ^XPAR supported by IA #2263
;Reference to DEM^VADPT supported by IA #10061
;
; This is routine contains several OR RPCs that have been cloned into the VIAB namespace
Q
;
ALLSPEC(RESULT,FROM,DIR) ; Return a set of specimens from topography file, clonded from ORWDLR32 ALLSPEC RPC
;Called by VIAB ALLSPEC RPC
;RESULT - Return results IEN for the entry in File 61 ^ .01 FIELD for the entry in File 61 (SNOMED CODE)
;Input
;FROM - starting point of the search
;DIR - Direction to search, forwards or backwards in the cross reference
;Returns the first 44 entries starting from the FROM parameter.
N I,IEN,CNT,A,%,NOW,B
D NOW^%DTC S NOW=$P(%,".")
S I=0,CNT=44
F Q:I'<CNT S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM="" D
. S IEN=0 F S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN D
. . S A=$G(^LAB(61,IEN,64.91)) S B=$P(A,"^",3) I B]"",B'>NOW Q
. . S I=I+1,RESULT(I)=IEN_U_FROM_" ("_$P($G(^LAB(61,IEN,0)),U,2)_")"
Q
;
GETLABTM(RESULT,VIADATE,VIALOC) ;Return list of lab collect times for a date and location
;Called by VIAB GET LAB TIMES
;This RPC is a similar to ORWDLR32 GET LAB TIMES
;RESULT - Returns the results
;Input:
;VIADATE - order datetime
;VIALOC - IEN for the location in the Hospital Location File (#44)
N VIADA,VIATI,VIANOW,VIADOW,X,%,%H
S RESULT(0)=0 Q:'$G(VIADATE)!($G(VIADATE)<0)!('$G(VIALOC))
S VIADA=$P(VIADATE,".",1)
S VIANOW=$$NOW^XLFDT,VIATI=$P(VIANOW,".",2)
I VIADA<$P(VIANOW,".",1) S RESULT(0)="-1^Dates in the past are not allowed." Q
I '+$$GET^XPAR(VIALOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") D
. S X=VIADA D DW^%DTC S VIADOW=X
. I '+$$GET^XPAR("ALL","LR COLLECT "_VIADOW,1,"Q") S RESULT(0)="-1^No collections on "_VIADOW Q
. I '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(VIADA,0)) S RESULT(0)="-1^No holiday collections" Q
I +RESULT(0)>-1 D
. D GETLST^XPAR(.RESULT,"ALL","LR PHLEBOTOMY COLLECTION","Q")
. I +$G(RESULT)=0 S RESULT(0)="-1^No lab collect times defined for this division" Q
S I=0 F S I=$O(RESULT(I)) Q:'I D
. D NOW^%DTC S VIATI=%,%H=+%H_","_+RESULT(I) D YMD^%DTC
. I (VIADA=$P(VIATI,".",1)),(+(VIADA+%)<+VIATI) K RESULT(I) S RESULT=RESULT-1 Q ; cutoff time has passed for this collect time
. S RESULT(I)=$P(RESULT(I),U,2)
I +$G(RESULT)=0,('$D(RESULT(0))) S RESULT(0)="-1^All of today's collection times have passed."
Q
;
LOCTYPE(RESULT,VIALOC) ; Returns type of location (C,W)
;Called by VIAB LOC TYPE RPC
;Returns C for Clinic or W for Ward, if the location is not a Ward or Clinic returns a -1
;Input:
;VIALOC = IEN for the location in the Hospital Location File ($44)
S RESULT=-1
Q:$G(VIALOC)=""
S RESULT=$P($G(^SC(+$G(VIALOC),0)),U,3)
Q
;
DOWSCH(RESULT,DFN,LOCIEN) ; return all schedules
;Called by VIAB DOWSCH
;This RPC is a similar to ORWDPS1 DOWSCH
;DFN - Patient DFN
;LOCIEN - IEN for the location in the Hospital Location File (#44)
N CNT,FREQ,ILST,VIABARRAY,WIEN
S WIEN=$$WARDIEN(+$G(LOCIEN))
D SCHED^PSS51P1(WIEN,.VIABARRAY)
S ILST=0
S CNT=0 F S CNT=$O(VIABARRAY(CNT)) Q:CNT'>0 D
.N NODE
.S NODE=$G(VIABARRAY(CNT))
.I $P(NODE,U,4)="C" D
..K ^TMP($J,"VIABRPC3 DOWSCH")
..D ZERO^PSS51P1($P(NODE,U),,,,"VIABRPC3 DOWSCH")
..S FREQ=$G(^TMP($J,"VIABRPC3 DOWSCH",$P(NODE,U),2))
..K ^TMP($J,"VIABRPC3 DOWSCH")
..I +FREQ=0 Q
..I +FREQ>1440 Q
..S ILST=ILST+1,RESULT(ILST)=$P(VIABARRAY(CNT),U,2,5)
Q
;
WARDIEN(LOCIEN) ;
N RESULT
S RESULT=0
I LOCIEN=0 Q RESULT
I $P($G(^SC(LOCIEN,42)),U)="" Q RESULT
S RESULT=+$P($G(^SC(LOCIEN,42)),U)
Q RESULT
;
LCFUTR(RESULT,VIALOC,VIADIV) ;Get # of days for future Lab Collects
;Called by VIAB FUTURE LAB COLLECTS
;This RPC is a similar to ORWDLR33 FUTURE LAB COLLECTS
; For Event Delay Order
; --VIALOC Event default location
; --VIADIV Event default division
S RESULT=0
Q:'$$FIND1^DIC(8989.51,,"X","LR LAB COLLECT FUTURE","B")
I $G(VIADIV) S RESULT=+$$GET^XPAR(+$G(VIALOC)_";SC("_"^"_+$G(VIADIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")
E S RESULT=+$$GET^XPAR(+$G(VIALOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")
Q
;
ICVALID(RESULT,VIATIME) ;Is the time a valid immediate collect time?
;Called by VIAB IC VALID
;This RPC is a similar to ORWDLR32 IC VALID
;VIATIME - Date/time in FileMan format
S VIATIME=$P(VIATIME,".",1)_"."_$E($P(VIATIME,".",2),1,4)
S RESULT=$$VALID^LR7OV4(DUZ(2),VIATIME)
Q
;
DEATEXT(RESULT) ;returns the mandatory dea text to show when a user checks a controlled substance order to be signed on the signature dialog
;Called by VIAB DEATEXT
;This RPC is a similar to ORDEA DEATEXT
N I,VIAY
D GETWP^XPAR(.VIAY,"SYS","OR DEA TEXT")
S I=0 F S I=$O(VIAY(I)) Q:'I S RESULT(I)=VIAY(I,0)
Q
;
GETDEM(RESULT,DFN) ; GET PATIENT DEMOGRAPHICS (Supported (#10061) DEM^VADPT API Call, PIMS Technical manual)
;INPUT DFN (REQUIRED)
;RETURNS RESULT ARRAY IN FORMAT OF:
;RESULT(1) The NAME of the patient. (e.g., ADTPATIENT,ONE)
;RESULT(2) The SSN of the patient in internal^external format.
;RESULT(3) The DOB of the patient in internal^external format.
;RESULT(4) The AGE of the patient as of today, unless a date of death exists, in which case the age returned will be as of that date. (e.g., 36)
;RESULT(5) The SEX of the patient in internal^external format. (e.g., M^MALE)
;RESULT(6) The DT Of Death of the patient, should one exist, in internal^external format.
;RESULT(7) Any REMARKS concerning this patient which may be on file. (e.g., Need to obtain dependent info.)
;RESULT(8) (Deprecated - see RESULT(12))
;RESULT(9) The RELIGION of the patient in internal^external format. (e.g., 99^CATHOLIC)
;RESULT(10) The MARITAL STATUS of the patient in internal^external format. (e.g., 1^MARRIED)
;RESULT(11) Number of entries found in the ETHNICITY INFORMATION multiple. (e.g., 1)
; "," Nth repetition of ETHNICITY INFORMATION for the patient in internal^external format. (e.g., 1^HISPANIC OR LATINO)
; "," METHOD OF COLLECTION for the Nth repetition of ETHNICITY
;RESULT(12) Number of entries found in the RACE INFORMATION multiple.
; "," Nth repetition of RACE INFORMATION for the patient in internal^external format. (e.g., 11^WHITE)
; "," METHOD OF COLLECTION for the Nth repetition of RACE INFORMATION for the patient in internal^external format. (e.g., 2^PROXY))
;RESULT(13) Patients' current pt preferred language (FM version^human readable)
; "," Pointer^human readable
;RESULT("BID") The PRIMARY SHORT ID for a patient. The format of this variable will depend on the type of patient if VAPTYP is set. (e.g., 6789)
;RESULT("PID") The PRIMARY LONG ID for a patient. The format of this variable will depend on the type of patient if VAPTYP is set. (e.g., 000-45-6789)
;Global Array will send data to webservice without array subscripts
;
I $G(DFN)="" S RESULT(0)="DFN REQUIRED - NOT RECEIVED" Q
S RESULT=$NA(^TMP("VIABDEM",$J))
D DEM^VADPT
M ^TMP("VIABDEM",$J)=VADM K VADM
M ^TMP("VIABDEM",$J)=VA K VA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIABRPC3 7663 printed Nov 22, 2024@17:55:16 Page 2
VIABRPC3 ;AAC/PB - VIA RPCs ;10/06/2016
+1 ;;1.0;VISTA INTEGRATION ADAPTER;**9,20**;06-FEB-2014;Build 5
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Reference to ^SC( supported by IA 10040
+4 ;Reference to XPAR APIS supported by IA 2263
+5 ;Reference to PSSP51P supported by IA 4546
+6 ;Reference to ^LAB(61 supported by IA 2388
+7 ;Reference to $$VALID^LR7OV4 supported by IA 2429#
+8 ; supported ICRs below.
+9 ;Reference to ^%DTC supported by IA # 10003
+10 ;Reference to $$FIND1^DIC supported by IA #2051
+11 ;Reference to GETS^DIQ supported by IA 2056#
+12 ;Reference to ^XLFDT supported by IA #10103
+13 ;Reference to ^XPAR supported by IA #2263
+14 ;Reference to DEM^VADPT supported by IA #10061
+15 ;
+16 ; This is routine contains several OR RPCs that have been cloned into the VIAB namespace
+17 QUIT
+18 ;
ALLSPEC(RESULT,FROM,DIR) ; Return a set of specimens from topography file, clonded from ORWDLR32 ALLSPEC RPC
+1 ;Called by VIAB ALLSPEC RPC
+2 ;RESULT - Return results IEN for the entry in File 61 ^ .01 FIELD for the entry in File 61 (SNOMED CODE)
+3 ;Input
+4 ;FROM - starting point of the search
+5 ;DIR - Direction to search, forwards or backwards in the cross reference
+6 ;Returns the first 44 entries starting from the FROM parameter.
+7 NEW I,IEN,CNT,A,%,NOW,B
+8 DO NOW^%DTC
SET NOW=$PIECE(%,".")
+9 SET I=0
SET CNT=44
+10 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^LAB(61,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+11 SET IEN=0
FOR
SET IEN=$ORDER(^LAB(61,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+12 SET A=$GET(^LAB(61,IEN,64.91))
SET B=$PIECE(A,"^",3)
IF B]""
IF B'>NOW
QUIT
+13 SET I=I+1
SET RESULT(I)=IEN_U_FROM_" ("_$PIECE($GET(^LAB(61,IEN,0)),U,2)_")"
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
GETLABTM(RESULT,VIADATE,VIALOC) ;Return list of lab collect times for a date and location
+1 ;Called by VIAB GET LAB TIMES
+2 ;This RPC is a similar to ORWDLR32 GET LAB TIMES
+3 ;RESULT - Returns the results
+4 ;Input:
+5 ;VIADATE - order datetime
+6 ;VIALOC - IEN for the location in the Hospital Location File (#44)
+7 NEW VIADA,VIATI,VIANOW,VIADOW,X,%,%H
+8 SET RESULT(0)=0
if '$GET(VIADATE)!($GET(VIADATE)<0)!('$GET(VIALOC))
QUIT
+9 SET VIADA=$PIECE(VIADATE,".",1)
+10 SET VIANOW=$$NOW^XLFDT
SET VIATI=$PIECE(VIANOW,".",2)
+11 IF VIADA<$PIECE(VIANOW,".",1)
SET RESULT(0)="-1^Dates in the past are not allowed."
QUIT
+12 IF '+$$GET^XPAR(VIALOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q")
Begin DoDot:1
+13 SET X=VIADA
DO DW^%DTC
SET VIADOW=X
+14 IF '+$$GET^XPAR("ALL","LR COLLECT "_VIADOW,1,"Q")
SET RESULT(0)="-1^No collections on "_VIADOW
QUIT
+15 IF '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q")
IF $DATA(^HOLIDAY(VIADA,0))
SET RESULT(0)="-1^No holiday collections"
QUIT
End DoDot:1
+16 IF +RESULT(0)>-1
Begin DoDot:1
+17 DO GETLST^XPAR(.RESULT,"ALL","LR PHLEBOTOMY COLLECTION","Q")
+18 IF +$GET(RESULT)=0
SET RESULT(0)="-1^No lab collect times defined for this division"
QUIT
End DoDot:1
+19 SET I=0
FOR
SET I=$ORDER(RESULT(I))
if 'I
QUIT
Begin DoDot:1
+20 DO NOW^%DTC
SET VIATI=%
SET %H=+%H_","_+RESULT(I)
DO YMD^%DTC
+21 ; cutoff time has passed for this collect time
IF (VIADA=$PIECE(VIATI,".",1))
IF (+(VIADA+%)<+VIATI)
KILL RESULT(I)
SET RESULT=RESULT-1
QUIT
+22 SET RESULT(I)=$PIECE(RESULT(I),U,2)
End DoDot:1
+23 IF +$GET(RESULT)=0
IF ('$DATA(RESULT(0)))
SET RESULT(0)="-1^All of today's collection times have passed."
+24 QUIT
+25 ;
LOCTYPE(RESULT,VIALOC) ; Returns type of location (C,W)
+1 ;Called by VIAB LOC TYPE RPC
+2 ;Returns C for Clinic or W for Ward, if the location is not a Ward or Clinic returns a -1
+3 ;Input:
+4 ;VIALOC = IEN for the location in the Hospital Location File ($44)
+5 SET RESULT=-1
+6 if $GET(VIALOC)=""
QUIT
+7 SET RESULT=$PIECE($GET(^SC(+$GET(VIALOC),0)),U,3)
+8 QUIT
+9 ;
DOWSCH(RESULT,DFN,LOCIEN) ; return all schedules
+1 ;Called by VIAB DOWSCH
+2 ;This RPC is a similar to ORWDPS1 DOWSCH
+3 ;DFN - Patient DFN
+4 ;LOCIEN - IEN for the location in the Hospital Location File (#44)
+5 NEW CNT,FREQ,ILST,VIABARRAY,WIEN
+6 SET WIEN=$$WARDIEN(+$GET(LOCIEN))
+7 DO SCHED^PSS51P1(WIEN,.VIABARRAY)
+8 SET ILST=0
+9 SET CNT=0
FOR
SET CNT=$ORDER(VIABARRAY(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+10 NEW NODE
+11 SET NODE=$GET(VIABARRAY(CNT))
+12 IF $PIECE(NODE,U,4)="C"
Begin DoDot:2
+13 KILL ^TMP($JOB,"VIABRPC3 DOWSCH")
+14 DO ZERO^PSS51P1($PIECE(NODE,U),,,,"VIABRPC3 DOWSCH")
+15 SET FREQ=$GET(^TMP($JOB,"VIABRPC3 DOWSCH",$PIECE(NODE,U),2))
+16 KILL ^TMP($JOB,"VIABRPC3 DOWSCH")
+17 IF +FREQ=0
QUIT
+18 IF +FREQ>1440
QUIT
+19 SET ILST=ILST+1
SET RESULT(ILST)=$PIECE(VIABARRAY(CNT),U,2,5)
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
WARDIEN(LOCIEN) ;
+1 NEW RESULT
+2 SET RESULT=0
+3 IF LOCIEN=0
QUIT RESULT
+4 IF $PIECE($GET(^SC(LOCIEN,42)),U)=""
QUIT RESULT
+5 SET RESULT=+$PIECE($GET(^SC(LOCIEN,42)),U)
+6 QUIT RESULT
+7 ;
LCFUTR(RESULT,VIALOC,VIADIV) ;Get # of days for future Lab Collects
+1 ;Called by VIAB FUTURE LAB COLLECTS
+2 ;This RPC is a similar to ORWDLR33 FUTURE LAB COLLECTS
+3 ; For Event Delay Order
+4 ; --VIALOC Event default location
+5 ; --VIADIV Event default division
+6 SET RESULT=0
+7 if '$$FIND1^DIC(8989.51,,"X","LR LAB COLLECT FUTURE","B")
QUIT
+8 IF $GET(VIADIV)
SET RESULT=+$$GET^XPAR(+$GET(VIALOC)_";SC("_"^"_+$GET(VIADIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")
+9 IF '$TEST
SET RESULT=+$$GET^XPAR(+$GET(VIALOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")
+10 QUIT
+11 ;
ICVALID(RESULT,VIATIME) ;Is the time a valid immediate collect time?
+1 ;Called by VIAB IC VALID
+2 ;This RPC is a similar to ORWDLR32 IC VALID
+3 ;VIATIME - Date/time in FileMan format
+4 SET VIATIME=$PIECE(VIATIME,".",1)_"."_$EXTRACT($PIECE(VIATIME,".",2),1,4)
+5 SET RESULT=$$VALID^LR7OV4(DUZ(2),VIATIME)
+6 QUIT
+7 ;
DEATEXT(RESULT) ;returns the mandatory dea text to show when a user checks a controlled substance order to be signed on the signature dialog
+1 ;Called by VIAB DEATEXT
+2 ;This RPC is a similar to ORDEA DEATEXT
+3 NEW I,VIAY
+4 DO GETWP^XPAR(.VIAY,"SYS","OR DEA TEXT")
+5 SET I=0
FOR
SET I=$ORDER(VIAY(I))
if 'I
QUIT
SET RESULT(I)=VIAY(I,0)
+6 QUIT
+7 ;
GETDEM(RESULT,DFN) ; GET PATIENT DEMOGRAPHICS (Supported (#10061) DEM^VADPT API Call, PIMS Technical manual)
+1 ;INPUT DFN (REQUIRED)
+2 ;RETURNS RESULT ARRAY IN FORMAT OF:
+3 ;RESULT(1) The NAME of the patient. (e.g., ADTPATIENT,ONE)
+4 ;RESULT(2) The SSN of the patient in internal^external format.
+5 ;RESULT(3) The DOB of the patient in internal^external format.
+6 ;RESULT(4) The AGE of the patient as of today, unless a date of death exists, in which case the age returned will be as of that date. (e.g., 36)
+7 ;RESULT(5) The SEX of the patient in internal^external format. (e.g., M^MALE)
+8 ;RESULT(6) The DT Of Death of the patient, should one exist, in internal^external format.
+9 ;RESULT(7) Any REMARKS concerning this patient which may be on file. (e.g., Need to obtain dependent info.)
+10 ;RESULT(8) (Deprecated - see RESULT(12))
+11 ;RESULT(9) The RELIGION of the patient in internal^external format. (e.g., 99^CATHOLIC)
+12 ;RESULT(10) The MARITAL STATUS of the patient in internal^external format. (e.g., 1^MARRIED)
+13 ;RESULT(11) Number of entries found in the ETHNICITY INFORMATION multiple. (e.g., 1)
+14 ; "," Nth repetition of ETHNICITY INFORMATION for the patient in internal^external format. (e.g., 1^HISPANIC OR LATINO)
+15 ; "," METHOD OF COLLECTION for the Nth repetition of ETHNICITY
+16 ;RESULT(12) Number of entries found in the RACE INFORMATION multiple.
+17 ; "," Nth repetition of RACE INFORMATION for the patient in internal^external format. (e.g., 11^WHITE)
+18 ; "," METHOD OF COLLECTION for the Nth repetition of RACE INFORMATION for the patient in internal^external format. (e.g., 2^PROXY))
+19 ;RESULT(13) Patients' current pt preferred language (FM version^human readable)
+20 ; "," Pointer^human readable
+21 ;RESULT("BID") The PRIMARY SHORT ID for a patient. The format of this variable will depend on the type of patient if VAPTYP is set. (e.g., 6789)
+22 ;RESULT("PID") The PRIMARY LONG ID for a patient. The format of this variable will depend on the type of patient if VAPTYP is set. (e.g., 000-45-6789)
+23 ;Global Array will send data to webservice without array subscripts
+24 ;
+25 IF $GET(DFN)=""
SET RESULT(0)="DFN REQUIRED - NOT RECEIVED"
QUIT
+26 SET RESULT=$NAME(^TMP("VIABDEM",$JOB))
+27 DO DEM^VADPT
+28 MERGE ^TMP("VIABDEM",$JOB)=VADM
KILL VADM
+29 MERGE ^TMP("VIABDEM",$JOB)=VA
KILL VA
+30 QUIT
+31 ;
