VPSRPC13.m

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 ---VPSRPC13   3229     printed  Apr 09, 2024@21:45:31                                                                                                                                                                                                    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