- 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 Feb 19, 2025@00:09:55 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