VPSRPC1 ;BPOIFO/EL,WOIFO/BT - Patient Demographic and Clinic RPC;08/14/14 09:28
;;1.0;VA POINT OF SERVICE (KIOSKS);**1,2,4,14**;Aug 8, 2014;Build 26
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #10035 - ^DPT( references (Supported)
; #10040 - ^SC( references (Supported)
; #2052 - DID call (Supported)
; #2056 - DIQ call (Supported)
; #2701 - MPIF001 call (Supported)
; #10104 - XLFSTR call (Supported)
; #5888 - RPCVIC^DPTLK (Controlled Sub)
; #10061 - VADPT call (Supported)
QUIT
;
GETCLN(VPSARR,CLNAM) ; RPC: VPS GET CLINIC - CLINIC NAME ENTRY
; Called by Vetlink Kiosk system.
; The RPC will accept 2 parameters. The first parameter represents the
; return value as required by RPC Broker, and the 2nd parameter is
; single input value representing the name of the clinic (full or partial
; name). The output produced will be an array that returns all the
; possible matches for the clinic (one to many clinics). Values returned
; will be the name of the clinic and the ien of the clinic.
;
; OUTPUT
; VPSARR - passed in by reference; return array of clinics that **contains** input string (CLNAM)
; INPUT
; CLNAM - partial or full name of clinic;
;
K VPSARR
I $G(CLNAM)="" S VPSARR(1)="-1^CLINIC NAME NOT SENT" QUIT
;
N VPSCLN,VPSIEN,LOCATION
N VPSUPNAM S VPSUPNAM=$$UP^XLFSTR(CLNAM)
N VPSCNAM S VPSCNAM=""
N VPSFL S VPSFL=44
;
F S VPSCNAM=$O(^SC("B",VPSCNAM)) QUIT:$G(VPSCNAM)="" I VPSCNAM[VPSUPNAM D
. S VPSCLN=""
. F S VPSCLN=$O(^SC("B",VPSCNAM,VPSCLN)) QUIT:$G(VPSCLN)="" D
. . S VPSIEN=VPSCLN
. . D SET(.VPSARR,VPSFL,VPSIEN,".001",VPSCLN,"CLINIC NUMBER") ;Clinic IEN
. . D SET(.VPSARR,VPSFL,VPSIEN,".01",VPSCNAM) ;Clinic Name
. . S LOCATION=$$GET1^DIQ(VPSFL,VPSCLN_",",10,"E") ;Physical Location
. . D SET(.VPSARR,VPSFL,VPSIEN,10,LOCATION)
;
I '$D(VPSARR) S VPSARR(1)="-1^CLINIC COULD NOT BE FOUND." QUIT
;
QUIT
;
GETDATA(VPSARR,SSN) ; RPC: VPS GET PATIENT DEMOGRAPHIC
; This RPC is called by the Vetlink Kiosk (point of service) system.
; Given Patient SSN, this RPC returns the patient demographics,insurance,and up-coming appointments, etc.
;
; INPUT
; SSN - patient SSN
; OUTPUT
; VPSARR - passed in by reference; return array of patient demographics
;
D GETDATA2(.VPSARR,$G(SSN),"SSN")
QUIT
;
GETDATA2(VPSARR,VPSNUM,VPSTYP) ; RPC: VPS GET2 PATIENT DEMOGRAPHIC
; This RPC is called by the Vetlink Kiosk (point of service) system.
; Given Patient SSN or DFN or ICN or VIC/CAC, this RPC returns the patient demographics,insurance,and up-coming appointments, etc.
;
; OUTPUT
; VPSARR - passed in by reference; return array of patient demographics,appts
; INPUT
; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
;
; Return all categories
N CATEGORY,ICAT ;F ICAT=1:1:6 S CATEGORY(ICAT)=ICAT
N ANS
D DT^DILF("E","T-60",.ANS)
S CATEGORY(1)=1_";"_ANS_":"
S CATEGORY(2)=6
D GETDATA3(.VPSARR,$G(VPSNUM),$G(VPSTYP),.CATEGORY) ; RPC: VPS GET2 PATIENT DEMOGRAPHIC
QUIT
;
GETDATA3(VPSARR,VPSNUM,VPSTYP,VPSCAT) ; RPC: VPS ENHANCED GET PATIENT DEMOGRAPHIC
; This RPC is called by the Vetlink Kiosk (point of service) system.
; Given Patient SSN or DFN or ICN or VIC/CAC, this RPC returns the patient demographics,insurance,and up-coming appointments, etc
; for selected categories
;
; OUTPUT
; VPSARR - passed in by reference; return array of patient demographics,appts
; INPUT
; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSCAT - List of Category to print (REQUIRED)
; VPSCAT(1..N)=CATEGORY;FROMDATE:THROUGHDATE
; Example input parameter :
; VPSCAT(1)=6 - Patient demographics
; VPSCAT(2)=1;3140101:3141231 - Appointments start from 1/1/2014 through 12/31/2014
; VPSCAT(3)=2;3140601:3140630 - Lab Orders start from 6/1/2014 through 6/30/2014
; Valid Category:
; 1 - Appointment (With Date Range option)
; 2 - Lab Orders (With Date Range option)
; 3 - Consults
; 4 - Radiology (With Date Range option)
; 5 - Problem
; 6 - Patient Characteristics
; - Patient Current Inpatient Status
; - Patient Ward Location
; - Patient Bed Assignment
; - Facility Directory Preference
; 7 - Patient Additional patient demographic data
; 8 - Patient Clinical (Health Factor)
;
;
K VPSARR
S VPSARR(1)=$$VALIDATE($G(VPSTYP),$G(VPSNUM))
QUIT:+VPSARR(1)=-1
;
N DFN S DFN=VPSARR(1)
K VPSARR
N CAT,DTRANGE,SEQ S SEQ=0
;
F S SEQ=$O(VPSCAT(SEQ)) QUIT:'SEQ D
. S CAT=$P(VPSCAT(SEQ),";")
. S DTRANGE=$P(VPSCAT(SEQ),";",2)
. I CAT=1,$P(DTRANGE,":")="" D
.. N ANS
.. D DT^DILF("E","T-60",.ANS)
.. S DTRANGE=ANS_":"_$P(DTRANGE,":",2)
. I CAT=1 D GETAPPT^VPSRPC11(.VPSARR,DFN,DTRANGE) ;Appointments
. I CAT=2 D GETLAB^VPSRPC12(.VPSARR,DFN,DTRANGE) ;Lab Orders
. I CAT=3 D GETCNSLT^VPSRPC13(.VPSARR,DFN,DTRANGE) ;Consult
. I CAT=4 D GETRAD^VPSRPC14(.VPSARR,DFN,DTRANGE) ;Radiology
. I CAT=5 D GETPRBLM^VPSRPC15(.VPSARR,DFN) ;Problem
. I CAT=6 D GETDEM^VPSRPC16(.VPSARR,DFN) ;Demographics
. I CAT=7 D GETADEM^VPSRPC15(.VPSARR,DFN) ; Additional demographic data
. I CAT=8 D GETHF^VPSRPC15(.VPSARR,DFN) ; Patient Health Factor
QUIT
;
VALIDATE(VPSTYP,VPSNUM) ;validate patient-id type and patient id value
; INPUT
; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
; RETURN
; DFN if patient-type/id pair is valid otherwise return -1^Errormessage
;
N CM S CM=","
;
QUIT:$G(VPSTYP)="" "-1^TYPE IS REQUIRED (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
QUIT:'$F(",SSN,DFN,ICN,VIC/CAC,",CM_VPSTYP_CM) "-1^INVALID TYPE (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
QUIT:$G(VPSNUM)="" "-1^"_VPSTYP_" IS REQUIRED"
;
N DFN S DFN=0
;
I VPSTYP="SSN" D
. N SSN S SSN=$TR(VPSNUM,"- ")
. I SSN'?1.N S DFN="-1"_U_"SSN SHOULD BE NUMERIC: "_VPSNUM QUIT
. S DFN=$O(^DPT("SSN",SSN,0))
. I +DFN'>0 S DFN="-1"_U_"NO PATIENT FOUND WITH SSN: "_VPSNUM
QUIT:DFN DFN
;
I VPSTYP="DFN" D
. S DFN=VPSNUM
. I '$D(^DPT(DFN)) S DFN="-1"_U_"NO PATIENT FOUND WITH DFN: "_DFN
QUIT:DFN DFN
;
I VPSTYP="VIC/CAC" D
. D RPCVIC^DPTLK(.DFN,VPSNUM) ; get DFN given VIC/CAC number - IA 5888
. S:DFN=-1 DFN="-1^INVALID VIC/CAC NUMBER "_VPSNUM
QUIT:DFN DFN
;
I VPSTYP="ICN" D
. S DFN=$$GETDFN^MPIF001(VPSNUM) ; get DFN given ICN in the Patient file - IA 2701
;
QUIT DFN
;
SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS,VPSCAT) ;Set line item to output array
; OUTPUT
; VPSARR - passed in by reference; This is the Array of clinics contains the line item
; INPUT
; VPSFL - File Number
; VPSIEN - File IEN
; VPSFLD - File Field Number
; VPSDA - Field Value
; VPSDS - (optional) User defined Field Name - default is the Fileman fieldname
; VPSCAT - Category: 1 - Appointment, 2 - Lab Orders, 3 - Consults, 4 - Radiology, 5 - Problem, 6 - Patient demographics
;
N CNT S CNT=$O(VPSARR(""),-1)+1
I $G(VPSDS)="",$G(VPSFL),$G(VPSFLD) N VPSOUT D FIELD^DID(VPSFL,VPSFLD,"","LABEL","VPSOUT") S VPSDS=VPSOUT("LABEL")
S VPSARR(CNT)=$G(VPSFL)_U_$G(VPSIEN)_U_$G(VPSFLD)_U_$G(VPSDA)_U_$G(VPSDS)_U_$G(VPSCAT)
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSRPC1 7918 printed Dec 13, 2024@02:43:24 Page 2
VPSRPC1 ;BPOIFO/EL,WOIFO/BT - Patient Demographic and Clinic RPC;08/14/14 09:28
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**1,2,4,14**;Aug 8, 2014;Build 26
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #10035 - ^DPT( references (Supported)
+7 ; #10040 - ^SC( references (Supported)
+8 ; #2052 - DID call (Supported)
+9 ; #2056 - DIQ call (Supported)
+10 ; #2701 - MPIF001 call (Supported)
+11 ; #10104 - XLFSTR call (Supported)
+12 ; #5888 - RPCVIC^DPTLK (Controlled Sub)
+13 ; #10061 - VADPT call (Supported)
+14 QUIT
+15 ;
GETCLN(VPSARR,CLNAM) ; RPC: VPS GET CLINIC - CLINIC NAME ENTRY
+1 ; Called by Vetlink Kiosk system.
+2 ; The RPC will accept 2 parameters. The first parameter represents the
+3 ; return value as required by RPC Broker, and the 2nd parameter is
+4 ; single input value representing the name of the clinic (full or partial
+5 ; name). The output produced will be an array that returns all the
+6 ; possible matches for the clinic (one to many clinics). Values returned
+7 ; will be the name of the clinic and the ien of the clinic.
+8 ;
+9 ; OUTPUT
+10 ; VPSARR - passed in by reference; return array of clinics that **contains** input string (CLNAM)
+11 ; INPUT
+12 ; CLNAM - partial or full name of clinic;
+13 ;
+14 KILL VPSARR
+15 IF $GET(CLNAM)=""
SET VPSARR(1)="-1^CLINIC NAME NOT SENT"
QUIT
+16 ;
+17 NEW VPSCLN,VPSIEN,LOCATION
+18 NEW VPSUPNAM
SET VPSUPNAM=$$UP^XLFSTR(CLNAM)
+19 NEW VPSCNAM
SET VPSCNAM=""
+20 NEW VPSFL
SET VPSFL=44
+21 ;
+22 FOR
SET VPSCNAM=$ORDER(^SC("B",VPSCNAM))
if $GET(VPSCNAM)=""
QUIT
IF VPSCNAM[VPSUPNAM
Begin DoDot:1
+23 SET VPSCLN=""
+24 FOR
SET VPSCLN=$ORDER(^SC("B",VPSCNAM,VPSCLN))
if $GET(VPSCLN)=""
QUIT
Begin DoDot:2
+25 SET VPSIEN=VPSCLN
+26 ;Clinic IEN
DO SET(.VPSARR,VPSFL,VPSIEN,".001",VPSCLN,"CLINIC NUMBER")
+27 ;Clinic Name
DO SET(.VPSARR,VPSFL,VPSIEN,".01",VPSCNAM)
+28 ;Physical Location
SET LOCATION=$$GET1^DIQ(VPSFL,VPSCLN_",",10,"E")
+29 DO SET(.VPSARR,VPSFL,VPSIEN,10,LOCATION)
End DoDot:2
End DoDot:1
+30 ;
+31 IF '$DATA(VPSARR)
SET VPSARR(1)="-1^CLINIC COULD NOT BE FOUND."
QUIT
+32 ;
+33 QUIT
+34 ;
GETDATA(VPSARR,SSN) ; RPC: VPS GET PATIENT DEMOGRAPHIC
+1 ; This RPC is called by the Vetlink Kiosk (point of service) system.
+2 ; Given Patient SSN, this RPC returns the patient demographics,insurance,and up-coming appointments, etc.
+3 ;
+4 ; INPUT
+5 ; SSN - patient SSN
+6 ; OUTPUT
+7 ; VPSARR - passed in by reference; return array of patient demographics
+8 ;
+9 DO GETDATA2(.VPSARR,$GET(SSN),"SSN")
+10 QUIT
+11 ;
GETDATA2(VPSARR,VPSNUM,VPSTYP) ; RPC: VPS GET2 PATIENT DEMOGRAPHIC
+1 ; This RPC is called by the Vetlink Kiosk (point of service) system.
+2 ; Given Patient SSN or DFN or ICN or VIC/CAC, this RPC returns the patient demographics,insurance,and up-coming appointments, etc.
+3 ;
+4 ; OUTPUT
+5 ; VPSARR - passed in by reference; return array of patient demographics,appts
+6 ; INPUT
+7 ; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+8 ; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+9 ;
+10 ; Return all categories
+11 ;F ICAT=1:1:6 S CATEGORY(ICAT)=ICAT
NEW CATEGORY,ICAT
+12 NEW ANS
+13 DO DT^DILF("E","T-60",.ANS)
+14 SET CATEGORY(1)=1_";"_ANS_":"
+15 SET CATEGORY(2)=6
+16 ; RPC: VPS GET2 PATIENT DEMOGRAPHIC
DO GETDATA3(.VPSARR,$GET(VPSNUM),$GET(VPSTYP),.CATEGORY)
+17 QUIT
+18 ;
GETDATA3(VPSARR,VPSNUM,VPSTYP,VPSCAT) ; RPC: VPS ENHANCED GET PATIENT DEMOGRAPHIC
+1 ; This RPC is called by the Vetlink Kiosk (point of service) system.
+2 ; Given Patient SSN or DFN or ICN or VIC/CAC, this RPC returns the patient demographics,insurance,and up-coming appointments, etc
+3 ; for selected categories
+4 ;
+5 ; OUTPUT
+6 ; VPSARR - passed in by reference; return array of patient demographics,appts
+7 ; INPUT
+8 ; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+9 ; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+10 ; VPSCAT - List of Category to print (REQUIRED)
+11 ; VPSCAT(1..N)=CATEGORY;FROMDATE:THROUGHDATE
+12 ; Example input parameter :
+13 ; VPSCAT(1)=6 - Patient demographics
+14 ; VPSCAT(2)=1;3140101:3141231 - Appointments start from 1/1/2014 through 12/31/2014
+15 ; VPSCAT(3)=2;3140601:3140630 - Lab Orders start from 6/1/2014 through 6/30/2014
+16 ; Valid Category:
+17 ; 1 - Appointment (With Date Range option)
+18 ; 2 - Lab Orders (With Date Range option)
+19 ; 3 - Consults
+20 ; 4 - Radiology (With Date Range option)
+21 ; 5 - Problem
+22 ; 6 - Patient Characteristics
+23 ; - Patient Current Inpatient Status
+24 ; - Patient Ward Location
+25 ; - Patient Bed Assignment
+26 ; - Facility Directory Preference
+27 ; 7 - Patient Additional patient demographic data
+28 ; 8 - Patient Clinical (Health Factor)
+29 ;
+30 ;
+31 KILL VPSARR
+32 SET VPSARR(1)=$$VALIDATE($GET(VPSTYP),$GET(VPSNUM))
+33 if +VPSARR(1)=-1
QUIT
+34 ;
+35 NEW DFN
SET DFN=VPSARR(1)
+36 KILL VPSARR
+37 NEW CAT,DTRANGE,SEQ
SET SEQ=0
+38 ;
+39 FOR
SET SEQ=$ORDER(VPSCAT(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+40 SET CAT=$PIECE(VPSCAT(SEQ),";")
+41 SET DTRANGE=$PIECE(VPSCAT(SEQ),";",2)
+42 IF CAT=1
IF $PIECE(DTRANGE,":")=""
Begin DoDot:2
+43 NEW ANS
+44 DO DT^DILF("E","T-60",.ANS)
+45 SET DTRANGE=ANS_":"_$PIECE(DTRANGE,":",2)
End DoDot:2
+46 ;Appointments
IF CAT=1
DO GETAPPT^VPSRPC11(.VPSARR,DFN,DTRANGE)
+47 ;Lab Orders
IF CAT=2
DO GETLAB^VPSRPC12(.VPSARR,DFN,DTRANGE)
+48 ;Consult
IF CAT=3
DO GETCNSLT^VPSRPC13(.VPSARR,DFN,DTRANGE)
+49 ;Radiology
IF CAT=4
DO GETRAD^VPSRPC14(.VPSARR,DFN,DTRANGE)
+50 ;Problem
IF CAT=5
DO GETPRBLM^VPSRPC15(.VPSARR,DFN)
+51 ;Demographics
IF CAT=6
DO GETDEM^VPSRPC16(.VPSARR,DFN)
+52 ; Additional demographic data
IF CAT=7
DO GETADEM^VPSRPC15(.VPSARR,DFN)
+53 ; Patient Health Factor
IF CAT=8
DO GETHF^VPSRPC15(.VPSARR,DFN)
End DoDot:1
+54 QUIT
+55 ;
VALIDATE(VPSTYP,VPSNUM) ;validate patient-id type and patient id value
+1 ; INPUT
+2 ; VPSTYP - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+3 ; VPSNUM - Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+4 ; RETURN
+5 ; DFN if patient-type/id pair is valid otherwise return -1^Errormessage
+6 ;
+7 NEW CM
SET CM=","
+8 ;
+9 if $GET(VPSTYP)=""
QUIT "-1^TYPE IS REQUIRED (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
+10 if '$FIND(",SSN,DFN,ICN,VIC/CAC,",CM_VPSTYP_CM)
QUIT "-1^INVALID TYPE (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
+11 if $GET(VPSNUM)=""
QUIT "-1^"_VPSTYP_" IS REQUIRED"
+12 ;
+13 NEW DFN
SET DFN=0
+14 ;
+15 IF VPSTYP="SSN"
Begin DoDot:1
+16 NEW SSN
SET SSN=$TRANSLATE(VPSNUM,"- ")
+17 IF SSN'?1.N
SET DFN="-1"_U_"SSN SHOULD BE NUMERIC: "_VPSNUM
QUIT
+18 SET DFN=$ORDER(^DPT("SSN",SSN,0))
+19 IF +DFN'>0
SET DFN="-1"_U_"NO PATIENT FOUND WITH SSN: "_VPSNUM
End DoDot:1
+20 if DFN
QUIT DFN
+21 ;
+22 IF VPSTYP="DFN"
Begin DoDot:1
+23 SET DFN=VPSNUM
+24 IF '$DATA(^DPT(DFN))
SET DFN="-1"_U_"NO PATIENT FOUND WITH DFN: "_DFN
End DoDot:1
+25 if DFN
QUIT DFN
+26 ;
+27 IF VPSTYP="VIC/CAC"
Begin DoDot:1
+28 ; get DFN given VIC/CAC number - IA 5888
DO RPCVIC^DPTLK(.DFN,VPSNUM)
+29 if DFN=-1
SET DFN="-1^INVALID VIC/CAC NUMBER "_VPSNUM
End DoDot:1
+30 if DFN
QUIT DFN
+31 ;
+32 IF VPSTYP="ICN"
Begin DoDot:1
+33 ; get DFN given ICN in the Patient file - IA 2701
SET DFN=$$GETDFN^MPIF001(VPSNUM)
End DoDot:1
+34 ;
+35 QUIT DFN
+36 ;
SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS,VPSCAT) ;Set line item to output array
+1 ; OUTPUT
+2 ; VPSARR - passed in by reference; This is the Array of clinics contains the line item
+3 ; INPUT
+4 ; VPSFL - File Number
+5 ; VPSIEN - File IEN
+6 ; VPSFLD - File Field Number
+7 ; VPSDA - Field Value
+8 ; VPSDS - (optional) User defined Field Name - default is the Fileman fieldname
+9 ; VPSCAT - Category: 1 - Appointment, 2 - Lab Orders, 3 - Consults, 4 - Radiology, 5 - Problem, 6 - Patient demographics
+10 ;
+11 NEW CNT
SET CNT=$ORDER(VPSARR(""),-1)+1
+12 IF $GET(VPSDS)=""
IF $GET(VPSFL)
IF $GET(VPSFLD)
NEW VPSOUT
DO FIELD^DID(VPSFL,VPSFLD,"","LABEL","VPSOUT")
SET VPSDS=VPSOUT("LABEL")
+13 SET VPSARR(CNT)=$GET(VPSFL)_U_$GET(VPSIEN)_U_$GET(VPSFLD)_U_$GET(VPSDA)_U_$GET(VPSDS)_U_$GET(VPSCAT)
+14 QUIT
