VPSRPC11 ;BPOIFO/EL,WOIFO/BT - Patient Demographic RPC - Appointment;9/4/14 13:07
;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Sep 4, 2014;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #2056 - DIQ call (Supported)
; #4433 - SDAMA301 call (Supported)
; #10103 - XLFDT call (Supported)
; #10104 - XLFSTR call (Supported)
QUIT
;
GETAPPT(VPSARR,DFN,DTRANGE) ; Appointment Info
; OUTPUT
; VPSARR - passed in by reference; this is the output array to store patient demographics
; INPUT
; DFN - patient DFN (This value must be validated before calling this procedure)
; DTRANGE - FROMDATE:THROUGH DATE
;
N TODAY S TODAY=$$DT^XLFDT()
N VPSFR S VPSFR=$P(DTRANGE,":")
N VPSTO S VPSTO=$P(DTRANGE,":",2)
S:VPSFR="" VPSFR=TODAY
S:VPSTO="" VPSTO=TODAY+20000
;
; -- Set filter
N VPSSD
S VPSSD(1)=VPSFR_":"_VPSTO
S VPSSD(3)="R;I;NS;NSR;R;CP;CPR;CC;CCR;NT"
S VPSSD(4)=DFN
S VPSSD("FLDS")="1;2;3;10;16;19;20;21;22"
;
; -- get appointments
K ^TMP($J,"SDAMA301",DFN)
N VAL S VAL=$$SDAPI^SDAMA301(.VPSSD)
I VAL'>0 D SET(.VPSARR,"E",DFN,"","NO APPOINTMENTS FOUND FOR PATIENT","APPOINTMENT NOT FOUND") QUIT
;
N VPSCL,VPSDT S (VPSCL,VPSDT)=""
N EXIST S EXIST=0
;
F S VPSCL=$O(^TMP($J,"SDAMA301",DFN,VPSCL)) QUIT:VPSCL="" D
. S VPSDT=""
. F S VPSDT=$O(^TMP($J,"SDAMA301",DFN,VPSCL,VPSDT)) QUIT:VPSDT="" D
. . S VPSAPT=^TMP($J,"SDAMA301",DFN,VPSCL,VPSDT)
. . S VPSIEN=DFN_";"_VPSCL_";"_VPSDT
. . D STAPPT(.VPSARR,VPSAPT,VPSIEN)
. . S EXIST=1
;
K ^TMP($J,"SDAMA301",DFN)
QUIT
;
STAPPT(VPSARR,VPSAPT,VPSIEN) ; Store appointments
; ------ Clinic Info ------------
N VAL S VAL=$P(VPSAPT,U,2)
N VPSCLN S VPSCLN=$P(VAL,";")
N VPSCNAM S VPSCNAM=$P(VAL,";",2)
;
; -- APPT CLINIC IEN/NAME #2
D SET(.VPSARR,2.98,VPSIEN,".01",VPSCLN)
;
; -- Hospital Location
N VPSFL S VPSFL="44"
D SET(.VPSARR,VPSFL,VPSIEN,".01",VPSCNAM)
S VAL=$$GET1^DIQ(VPSFL,VPSCLN_",",10,"E")
D SET(.VPSARR,VPSFL,VPSIEN,10,VAL) ; HOSPITAL PHYSICAL LOCATION
;
; ------ Appt Info ---------------
S VPSFL="2.98"
S VAL=$P(VPSAPT,U,1) D SET(.VPSARR,VPSFL,VPSIEN,".001",VAL,"APPOINTMENT DATE/TIME") ; APPT DATE/TIME #1
S VAL=$P(VPSAPT,U,3) D SET(.VPSARR,VPSFL,VPSIEN,3,VAL) ; STATUS #3
S VAL=$P($P(VPSAPT,U,22),";",3) D SET(.VPSARR,VPSFL,VPSIEN,100,VAL) ; CURRENT STATUS #22
S VAL=$P($P(VPSAPT,U,10),";",2) D SET(.VPSARR,VPSFL,VPSIEN,9.5,VAL) ; APPT TYPE IEN/NAME #10
S VAL=$P(VPSAPT,U,16) D SET(.VPSARR,VPSFL,VPSIEN,20,VAL) ; DATE APPT MADE #16
S VAL=$P(VPSAPT,U,19) D SET(.VPSARR,VPSFL,VPSIEN,7,VAL) ; EKG DATE/TIME #19
S VAL=$P(VPSAPT,U,20) D SET(.VPSARR,VPSFL,VPSIEN,6,VAL) ; X-RAY DATE/TIME #20
S VAL=$P(VPSAPT,U,21) D SET(.VPSARR,VPSFL,VPSIEN,5,VAL) ; LAB DATE/TIME #21
;
N VPSDFN,VPSDT,FLD S VPSDFN=$P(VPSIEN,";") S VPSDT=$P(VPSIEN,";",3)
S VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",14,"E") D SET(.VPSARR,VPSFL,VPSIEN,14,VAL) ; NO-SHOW/CANCELED BY #29
S VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",15,"I") D SET(.VPSARR,VPSFL,VPSIEN,15,VAL) ; NO-SHOW/CANCELED DATE/TM #25
S VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",16,"E") D SET(.VPSARR,VPSFL,VPSIEN,16,VAL) ; Cancellation Reason #32
S VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",17,"E") D SET(.VPSARR,VPSFL,VPSIEN,17,VAL) ; Cancellation Remarks
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),1) ;Set line item to output array
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSRPC11 3638 printed Dec 13, 2024@02:43:26 Page 2
VPSRPC11 ;BPOIFO/EL,WOIFO/BT - Patient Demographic RPC - Appointment;9/4/14 13:07
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Sep 4, 2014;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #2056 - DIQ call (Supported)
+7 ; #4433 - SDAMA301 call (Supported)
+8 ; #10103 - XLFDT call (Supported)
+9 ; #10104 - XLFSTR call (Supported)
+10 QUIT
+11 ;
GETAPPT(VPSARR,DFN,DTRANGE) ; Appointment Info
+1 ; OUTPUT
+2 ; VPSARR - passed in by reference; this is the output array to store patient demographics
+3 ; INPUT
+4 ; DFN - patient DFN (This value must be validated before calling this procedure)
+5 ; DTRANGE - FROMDATE:THROUGH DATE
+6 ;
+7 NEW TODAY
SET TODAY=$$DT^XLFDT()
+8 NEW VPSFR
SET VPSFR=$PIECE(DTRANGE,":")
+9 NEW VPSTO
SET VPSTO=$PIECE(DTRANGE,":",2)
+10 if VPSFR=""
SET VPSFR=TODAY
+11 if VPSTO=""
SET VPSTO=TODAY+20000
+12 ;
+13 ; -- Set filter
+14 NEW VPSSD
+15 SET VPSSD(1)=VPSFR_":"_VPSTO
+16 SET VPSSD(3)="R;I;NS;NSR;R;CP;CPR;CC;CCR;NT"
+17 SET VPSSD(4)=DFN
+18 SET VPSSD("FLDS")="1;2;3;10;16;19;20;21;22"
+19 ;
+20 ; -- get appointments
+21 KILL ^TMP($JOB,"SDAMA301",DFN)
+22 NEW VAL
SET VAL=$$SDAPI^SDAMA301(.VPSSD)
+23 IF VAL'>0
DO SET(.VPSARR,"E",DFN,"","NO APPOINTMENTS FOUND FOR PATIENT","APPOINTMENT NOT FOUND")
QUIT
+24 ;
+25 NEW VPSCL,VPSDT
SET (VPSCL,VPSDT)=""
+26 NEW EXIST
SET EXIST=0
+27 ;
+28 FOR
SET VPSCL=$ORDER(^TMP($JOB,"SDAMA301",DFN,VPSCL))
if VPSCL=""
QUIT
Begin DoDot:1
+29 SET VPSDT=""
+30 FOR
SET VPSDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,VPSCL,VPSDT))
if VPSDT=""
QUIT
Begin DoDot:2
+31 SET VPSAPT=^TMP($JOB,"SDAMA301",DFN,VPSCL,VPSDT)
+32 SET VPSIEN=DFN_";"_VPSCL_";"_VPSDT
+33 DO STAPPT(.VPSARR,VPSAPT,VPSIEN)
+34 SET EXIST=1
End DoDot:2
End DoDot:1
+35 ;
+36 KILL ^TMP($JOB,"SDAMA301",DFN)
+37 QUIT
+38 ;
STAPPT(VPSARR,VPSAPT,VPSIEN) ; Store appointments
+1 ; ------ Clinic Info ------------
+2 NEW VAL
SET VAL=$PIECE(VPSAPT,U,2)
+3 NEW VPSCLN
SET VPSCLN=$PIECE(VAL,";")
+4 NEW VPSCNAM
SET VPSCNAM=$PIECE(VAL,";",2)
+5 ;
+6 ; -- APPT CLINIC IEN/NAME #2
+7 DO SET(.VPSARR,2.98,VPSIEN,".01",VPSCLN)
+8 ;
+9 ; -- Hospital Location
+10 NEW VPSFL
SET VPSFL="44"
+11 DO SET(.VPSARR,VPSFL,VPSIEN,".01",VPSCNAM)
+12 SET VAL=$$GET1^DIQ(VPSFL,VPSCLN_",",10,"E")
+13 ; HOSPITAL PHYSICAL LOCATION
DO SET(.VPSARR,VPSFL,VPSIEN,10,VAL)
+14 ;
+15 ; ------ Appt Info ---------------
+16 SET VPSFL="2.98"
+17 ; APPT DATE/TIME #1
SET VAL=$PIECE(VPSAPT,U,1)
DO SET(.VPSARR,VPSFL,VPSIEN,".001",VAL,"APPOINTMENT DATE/TIME")
+18 ; STATUS #3
SET VAL=$PIECE(VPSAPT,U,3)
DO SET(.VPSARR,VPSFL,VPSIEN,3,VAL)
+19 ; CURRENT STATUS #22
SET VAL=$PIECE($PIECE(VPSAPT,U,22),";",3)
DO SET(.VPSARR,VPSFL,VPSIEN,100,VAL)
+20 ; APPT TYPE IEN/NAME #10
SET VAL=$PIECE($PIECE(VPSAPT,U,10),";",2)
DO SET(.VPSARR,VPSFL,VPSIEN,9.5,VAL)
+21 ; DATE APPT MADE #16
SET VAL=$PIECE(VPSAPT,U,16)
DO SET(.VPSARR,VPSFL,VPSIEN,20,VAL)
+22 ; EKG DATE/TIME #19
SET VAL=$PIECE(VPSAPT,U,19)
DO SET(.VPSARR,VPSFL,VPSIEN,7,VAL)
+23 ; X-RAY DATE/TIME #20
SET VAL=$PIECE(VPSAPT,U,20)
DO SET(.VPSARR,VPSFL,VPSIEN,6,VAL)
+24 ; LAB DATE/TIME #21
SET VAL=$PIECE(VPSAPT,U,21)
DO SET(.VPSARR,VPSFL,VPSIEN,5,VAL)
+25 ;
+26 NEW VPSDFN,VPSDT,FLD
SET VPSDFN=$PIECE(VPSIEN,";")
SET VPSDT=$PIECE(VPSIEN,";",3)
+27 ; NO-SHOW/CANCELED BY #29
SET VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",14,"E")
DO SET(.VPSARR,VPSFL,VPSIEN,14,VAL)
+28 ; NO-SHOW/CANCELED DATE/TM #25
SET VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",15,"I")
DO SET(.VPSARR,VPSFL,VPSIEN,15,VAL)
+29 ; Cancellation Reason #32
SET VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",16,"E")
DO SET(.VPSARR,VPSFL,VPSIEN,16,VAL)
+30 ; Cancellation Remarks
SET VAL=$$GET1^DIQ(VPSFL,VPSDT_","_VPSDFN_",",17,"E")
DO SET(.VPSARR,VPSFL,VPSIEN,17,VAL)
+31 QUIT
+32 ;
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),1)
+2 QUIT
