VPSRPC13 ;WOIFO/BT - Patient Demographic RPC - Consult/Procedure;08/14/14 13:07
;;1.0;VA POINT OF SERVICE (KIOSKS);**4,14**;Aug 14, 2014;Build 26
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #2740 - Call to OER^GMRCSLM1 (Controlled Subs)
; #1252 - Call to $$OUTPTPR^SDUTL3 (Supported)
; #1252 - Call to $$OUTPTTM^SDUTL3 (Supported)
; #6116 - Read-Only access to File #123, Fields .01,.03,3,5,8,10,13,17 (Controlled Subs)
QUIT
;
GETCNSLT(VPSARR,DFN,PARAMS) ;given DFN, returns the patient lab
; OUTPUT
; VPSARR - passed in by reference; this is the output array to store Consult
; INPUT
; DFN - patient DFN (This value must be validated before calling this procedure)
; PARAMS - optional date range
;
N ORSERV S ORSERV="" ;Service
S PARAMS=$G(PARAMS)
N ORSDT S ORSDT=$P(PARAMS,":") ;Beg Date for Search
N OREDT S OREDT=$P(PARAMS,":",2) ;End Date for Search
N ORSTATUS S ORSTATUS="" ;ALL STATI
N GMRCOER S GMRCOER=2 ;0 if request is from CONSULTS, 1 if request is for CPRS List Manager, 2 if for CPRS GUI
;
K ^TMP("GMRCR",$J)
D OER^GMRCSLM1(DFN,ORSERV,ORSDT,OREDT,ORSTATUS,GMRCOER) ;Return list of consult/procedures
;
N CSLTIEN,VAL,DATA
N SEQ S SEQ=0
N EXIST S EXIST=0
;
F S SEQ=$O(^TMP("GMRCR",$J,"CS",SEQ)) QUIT:'SEQ D
. S DATA=$G(^TMP("GMRCR",$J,"CS",SEQ,0))
. QUIT:$F(DATA,"PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS")
. S EXIST=1
. S CSLTIEN=$P(DATA,U) D SET(.VPSARR,123,DFN_";"_CSLTIEN,.001,CSLTIEN,"CONSULT IEN") ; CONSULT IEN
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",.01,"I") D SET(.VPSARR,123,DFN_";"_CSLTIEN,.01,VAL) ; FILE ENTRY DATE
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",8,"E") D SET(.VPSARR,123,DFN_";"_CSLTIEN,8,VAL) ; CPRS STATUS
. S VAL=$P(DATA,U,4) D SET(.VPSARR,123.5,DFN_";"_CSLTIEN,.01,VAL,"CONSULT NAME") ; CONSULT NAME
. S VAL=$$OUTPTPR^SDUTL3(DFN) D SET(.VPSARR,200,DFN,.01,$P(VAL,U,2),"PC PROVIDER") ; PC PROVIDER
. S VAL=$$OUTPTTM^SDUTL3(DFN) D SET(.VPSARR,404.51,DFN,.01,$P(VAL,U,2),"PC TEAM") ; PC TEAM NAME
. S VAL=$P(DATA,U,5) D SET(.VPSARR,123,DFN_";"_CSLTIEN,4,VAL,"PROCEDURE") ; CONSULT/PROC/REQUEST TYPE
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",.03,"E") D SET(.VPSARR,123,DFN_";"_CSLTIEN,.03,VAL) ; OE/RR FILE NUMBER
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",13,"E") D SET(.VPSARR,123,DFN_";"_CSLTIEN,13,VAL,"REQUEST TYPE") ; REQUEST TYPE
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",10,"E") D SET(.VPSARR,123,DFN_";"_CSLTIEN,10,VAL) ; SENDING PROVIDER/REQUESTED PC PROVIDER
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",17,"I") D SET(.VPSARR,123,DFN_";"_CSLTIEN,17,VAL) ; EARLIEST APPT.DATE/SCHEDULED PC APP DATE
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",3,"I") D SET(.VPSARR,123,DFN_";"_CSLTIEN,3,VAL) ; DATE OF REQUEST
. S VAL=$$GET1^DIQ(123,CSLTIEN_",",5,"E") D SET(.VPSARR,123,DFN_";"_CSLTIEN,5,VAL) ; URGENCY
;
I 'EXIST D SET(.VPSARR,"E",DFN,"","NO CONSULT DETAIL RECORDS FOUND FOR PATIENT","CONSULT NOT FOUND")
K ^TMP("GMRCR",$J)
QUIT
;
SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS) ;Set line item to output array
I VPSDA'="" D SET^VPSRPC1(.VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,$G(VPSDS),3) ;Set line item to output array
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSRPC13 3229 printed Dec 13, 2024@02:43:27 Page 2
VPSRPC13 ;WOIFO/BT - Patient Demographic RPC - Consult/Procedure;08/14/14 13:07
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**4,14**;Aug 14, 2014;Build 26
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #2740 - Call to OER^GMRCSLM1 (Controlled Subs)
+7 ; #1252 - Call to $$OUTPTPR^SDUTL3 (Supported)
+8 ; #1252 - Call to $$OUTPTTM^SDUTL3 (Supported)
+9 ; #6116 - Read-Only access to File #123, Fields .01,.03,3,5,8,10,13,17 (Controlled Subs)
+10 QUIT
+11 ;
GETCNSLT(VPSARR,DFN,PARAMS) ;given DFN, returns the patient lab
+1 ; OUTPUT
+2 ; VPSARR - passed in by reference; this is the output array to store Consult
+3 ; INPUT
+4 ; DFN - patient DFN (This value must be validated before calling this procedure)
+5 ; PARAMS - optional date range
+6 ;
+7 ;Service
NEW ORSERV
SET ORSERV=""
+8 SET PARAMS=$GET(PARAMS)
+9 ;Beg Date for Search
NEW ORSDT
SET ORSDT=$PIECE(PARAMS,":")
+10 ;End Date for Search
NEW OREDT
SET OREDT=$PIECE(PARAMS,":",2)
+11 ;ALL STATI
NEW ORSTATUS
SET ORSTATUS=""
+12 ;0 if request is from CONSULTS, 1 if request is for CPRS List Manager, 2 if for CPRS GUI
NEW GMRCOER
SET GMRCOER=2
+13 ;
+14 KILL ^TMP("GMRCR",$JOB)
+15 ;Return list of consult/procedures
DO OER^GMRCSLM1(DFN,ORSERV,ORSDT,OREDT,ORSTATUS,GMRCOER)
+16 ;
+17 NEW CSLTIEN,VAL,DATA
+18 NEW SEQ
SET SEQ=0
+19 NEW EXIST
SET EXIST=0
+20 ;
+21 FOR
SET SEQ=$ORDER(^TMP("GMRCR",$JOB,"CS",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+22 SET DATA=$GET(^TMP("GMRCR",$JOB,"CS",SEQ,0))
+23 if $FIND(DATA,"PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS")
QUIT
+24 SET EXIST=1
+25 ; CONSULT IEN
SET CSLTIEN=$PIECE(DATA,U)
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,.001,CSLTIEN,"CONSULT IEN")
+26 ; FILE ENTRY DATE
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",.01,"I")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,.01,VAL)
+27 ; CPRS STATUS
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",8,"E")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,8,VAL)
+28 ; CONSULT NAME
SET VAL=$PIECE(DATA,U,4)
DO SET(.VPSARR,123.5,DFN_";"_CSLTIEN,.01,VAL,"CONSULT NAME")
+29 ; PC PROVIDER
SET VAL=$$OUTPTPR^SDUTL3(DFN)
DO SET(.VPSARR,200,DFN,.01,$PIECE(VAL,U,2),"PC PROVIDER")
+30 ; PC TEAM NAME
SET VAL=$$OUTPTTM^SDUTL3(DFN)
DO SET(.VPSARR,404.51,DFN,.01,$PIECE(VAL,U,2),"PC TEAM")
+31 ; CONSULT/PROC/REQUEST TYPE
SET VAL=$PIECE(DATA,U,5)
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,4,VAL,"PROCEDURE")
+32 ; OE/RR FILE NUMBER
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",.03,"E")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,.03,VAL)
+33 ; REQUEST TYPE
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",13,"E")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,13,VAL,"REQUEST TYPE")
+34 ; SENDING PROVIDER/REQUESTED PC PROVIDER
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",10,"E")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,10,VAL)
+35 ; EARLIEST APPT.DATE/SCHEDULED PC APP DATE
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",17,"I")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,17,VAL)
+36 ; DATE OF REQUEST
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",3,"I")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,3,VAL)
+37 ; URGENCY
SET VAL=$$GET1^DIQ(123,CSLTIEN_",",5,"E")
DO SET(.VPSARR,123,DFN_";"_CSLTIEN,5,VAL)
End DoDot:1
+38 ;
+39 IF 'EXIST
DO SET(.VPSARR,"E",DFN,"","NO CONSULT DETAIL RECORDS FOUND FOR PATIENT","CONSULT NOT FOUND")
+40 KILL ^TMP("GMRCR",$JOB)
+41 QUIT
+42 ;
SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS) ;Set line item to output array
+1 ;Set line item to output array
IF VPSDA'=""
DO SET^VPSRPC1(.VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,$GET(VPSDS),3)
+2 QUIT
