VPSRPC3 ;DALOI/KML - VPS Pre-registration RPC ;4/26/2012
;;1.0;VA POINT OF SERVICE (KIOSKS);**2**;Oct 21, 2011;Build 41
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
; the procedures for this RPC were taken from the routine that supports the DGPRE PRE-REGISTER OPTION
; to update the various files when a Vetlink Kiosk Preregister event occurs
PREREG(RESULT,DFN,PRESTAT) ; Pre-Register a patient
; RPC=VPS PATIENT PRE-REGISTRATION
; input variables
; DFN - patient IEN, required
; PRESTAT - code for the call such as 'C' = 'CONTACTED' or
; 'X' = 'CHANGE INFORMATION', required
; output variable
; RESULT - variable that returns the result of the RPC, includes a
; a number (1 or 0) followed by a short message
N VALID
K RESULT
; check for required parameters coming in
I $G(DFN)="" S RESULT="0,DFN not sent." Q
I +DFN=0 S RESULT="0,invalid DFN." Q
I '$D(^DPT(DFN,0)) S RESULT="0,Patient not found." Q
; validate code for call status
I $G(PRESTAT)="" S RESULT="0,call STATUS code not sent." Q
S VALID=$$CHKST(PRESTAT) I 'VALID S RESULT="0,Invalid code for call status." Q
N PIEN,PDIV,PIDX,NEW,LOCK
S (PIDX,LOCK)=0,NEW=1
; PREREGISTRATION Nightly BACKGROUND JOB (SCHEDULED TASK) adds new entries to 41.42.
; VistA preregistration option allows processing to continue if there isn't a patient entry in 41.42.
I $D(^DGS(41.42,"B",DFN)) D ; ICR 5817
. S NEW=0
. S PIDX=$O(^DGS(41.42,"B",DFN,PIDX))
. S PDIV=$P($G(^DGS(41.42,PIDX,0)),U,2)
. I PIDX]"" L +^DGS(41.42,PIDX):2 I $T S LOCK=1
I 'LOCK&('NEW) S RESULT="0,Another user is editing this patient. Preregistration cannot be performed at this time." Q
I $G(PDIV)']"" S PDIV=$$PRIM^VASITE ; ICR#10112 - $$PRIM^VASITE
D UPDLOG(DFN,PRESTAT,PDIV)
; update pre-registration audit log
; need to include ICR #
N TMSTMP S TMSTMP=$$NOW^XLFDT ; ICR 10103
; add an entry to PRE-REGISTRATION AUDIT file
; ICR # 5797
S DIC="^DGS(41.41,",DIC(0)="L",X=DFN
S DIC("DR")="1///^S X=TMSTMP;2////^S X=DUZ"
D FILE^DICN
; need to update the PRE-REGISTRATION CALL LIST file
I 'NEW,PIDX D
. K DA,DIE,DR
. S DA=PIDX,DIE="^DGS(41.42,"
. S DR="4///Y" S DR=DR_";3///^S X=TMSTMP"
. D ^DIE
. L -^DGS(41.42,PIDX)
S RESULT="1,Pre-Registration completed."
;
Q
UPDLOG(DFN,STATUS,DIVIEN) ; Update PRE-REGISTRATION CALL File, #41.43
; ICR # 5798 - allows VPS package to add and edit an entry in the PRE-REGISTRATION CALL file
; Input:
; DFN - The IEN of the patient being called
; STATUS - Status of the call attempt
; DIVIEN - Division IEN (used for sorting)
;
N DIC,X,Y,DIE,DR,DA,DIK
S DIC="^DGS(41.43,"
S DIC(0)="L"
S X=$$NOW^XLFDT
D FILE^DICN
Q:Y<0 ; VistA option notifies user when an entry cannot be added to 41.43, but continues with processing the preregistration session.
S DA=+Y
L +^DGS(41.43,+Y):2 I '$T S DIK="^DGS(41.43," D ^DIK K DIK Q ; remove stub entry if entry cannot be locked
S DIE="^DGS(41.43,"
S DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=STATUS;5////^S X=$S(+DIVIEN>0:DIVIEN,1:"""")"
D ^DIE K DIE
L -^DGS(41.43,DA)
Q
;
CHKST(CODE) ; determine if status code is valid
; input -
; CODE = status of pre-registration call - this code is sent to the RPC from the Vetlink Kiosk
; output -
; FOUND = result of the validation which determines if the incoming kiosk code was matched against one of the valid VistA codes
N LIST,VALUE,FOUND
S VALUE="",FOUND=0
D BLDCODES(.LIST)
F S VALUE=$O(LIST(VALUE)) Q:VALUE="" Q:FOUND I VALUE=CODE S FOUND=1
Q FOUND
;
BLDCODES(ARRAY) ;build array of valid statuses that represent the outcome of the call to the patient
; valid codes can be located at the STATUS field of the PRE-REGISTRATION CALL LOG (#41.43,3).
;input/output - ARRAY passed in by reference
N LN,LINE,STRING
F LN=1:1 S LINE=$T(CODELST+LN),STRING=$P(LINE,";;",2) Q:STRING="" S ARRAY($P(STRING,U))=""
Q
;
CODELST ; list of codes
;;B^BUSY
;;C^CONNECTED
;;D^DEATH
;;K^CALL BACK
;;M^LEFT CALLBACK MESSAGE
;;N^NO ANSWER
;;P^NO PHONE
;;T^DON'T CALL
;;U^UNCOOPERATIVE
;;V^PREVIOUSLY UPDATED
;;W^WRONG NUMBER
;;X^CHANGE INFORMATION
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSRPC3 4216 printed Dec 13, 2024@02:43:34 Page 2
VPSRPC3 ;DALOI/KML - VPS Pre-registration RPC ;4/26/2012
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**2**;Oct 21, 2011;Build 41
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; the procedures for this RPC were taken from the routine that supports the DGPRE PRE-REGISTER OPTION
+6 ; to update the various files when a Vetlink Kiosk Preregister event occurs
PREREG(RESULT,DFN,PRESTAT) ; Pre-Register a patient
+1 ; RPC=VPS PATIENT PRE-REGISTRATION
+2 ; input variables
+3 ; DFN - patient IEN, required
+4 ; PRESTAT - code for the call such as 'C' = 'CONTACTED' or
+5 ; 'X' = 'CHANGE INFORMATION', required
+6 ; output variable
+7 ; RESULT - variable that returns the result of the RPC, includes a
+8 ; a number (1 or 0) followed by a short message
+9 NEW VALID
+10 KILL RESULT
+11 ; check for required parameters coming in
+12 IF $GET(DFN)=""
SET RESULT="0,DFN not sent."
QUIT
+13 IF +DFN=0
SET RESULT="0,invalid DFN."
QUIT
+14 IF '$DATA(^DPT(DFN,0))
SET RESULT="0,Patient not found."
QUIT
+15 ; validate code for call status
+16 IF $GET(PRESTAT)=""
SET RESULT="0,call STATUS code not sent."
QUIT
+17 SET VALID=$$CHKST(PRESTAT)
IF 'VALID
SET RESULT="0,Invalid code for call status."
QUIT
+18 NEW PIEN,PDIV,PIDX,NEW,LOCK
+19 SET (PIDX,LOCK)=0
SET NEW=1
+20 ; PREREGISTRATION Nightly BACKGROUND JOB (SCHEDULED TASK) adds new entries to 41.42.
+21 ; VistA preregistration option allows processing to continue if there isn't a patient entry in 41.42.
+22 ; ICR 5817
IF $DATA(^DGS(41.42,"B",DFN))
Begin DoDot:1
+23 SET NEW=0
+24 SET PIDX=$ORDER(^DGS(41.42,"B",DFN,PIDX))
+25 SET PDIV=$PIECE($GET(^DGS(41.42,PIDX,0)),U,2)
+26 IF PIDX]""
LOCK +^DGS(41.42,PIDX):2
IF $TEST
SET LOCK=1
End DoDot:1
+27 IF 'LOCK&('NEW)
SET RESULT="0,Another user is editing this patient. Preregistration cannot be performed at this time."
QUIT
+28 ; ICR#10112 - $$PRIM^VASITE
IF $GET(PDIV)']""
SET PDIV=$$PRIM^VASITE
+29 DO UPDLOG(DFN,PRESTAT,PDIV)
+30 ; update pre-registration audit log
+31 ; need to include ICR #
+32 ; ICR 10103
NEW TMSTMP
SET TMSTMP=$$NOW^XLFDT
+33 ; add an entry to PRE-REGISTRATION AUDIT file
+34 ; ICR # 5797
+35 SET DIC="^DGS(41.41,"
SET DIC(0)="L"
SET X=DFN
+36 SET DIC("DR")="1///^S X=TMSTMP;2////^S X=DUZ"
+37 DO FILE^DICN
+38 ; need to update the PRE-REGISTRATION CALL LIST file
+39 IF 'NEW
IF PIDX
Begin DoDot:1
+40 KILL DA,DIE,DR
+41 SET DA=PIDX
SET DIE="^DGS(41.42,"
+42 SET DR="4///Y"
SET DR=DR_";3///^S X=TMSTMP"
+43 DO ^DIE
+44 LOCK -^DGS(41.42,PIDX)
End DoDot:1
+45 SET RESULT="1,Pre-Registration completed."
+46 ;
+47 QUIT
UPDLOG(DFN,STATUS,DIVIEN) ; Update PRE-REGISTRATION CALL File, #41.43
+1 ; ICR # 5798 - allows VPS package to add and edit an entry in the PRE-REGISTRATION CALL file
+2 ; Input:
+3 ; DFN - The IEN of the patient being called
+4 ; STATUS - Status of the call attempt
+5 ; DIVIEN - Division IEN (used for sorting)
+6 ;
+7 NEW DIC,X,Y,DIE,DR,DA,DIK
+8 SET DIC="^DGS(41.43,"
+9 SET DIC(0)="L"
+10 SET X=$$NOW^XLFDT
+11 DO FILE^DICN
+12 ; VistA option notifies user when an entry cannot be added to 41.43, but continues with processing the preregistration session.
if Y<0
QUIT
+13 SET DA=+Y
+14 ; remove stub entry if entry cannot be locked
LOCK +^DGS(41.43,+Y):2
IF '$TEST
SET DIK="^DGS(41.43,"
DO ^DIK
KILL DIK
QUIT
+15 SET DIE="^DGS(41.43,"
+16 SET DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=STATUS;5////^S X=$S(+DIVIEN>0:DIVIEN,1:"""")"
+17 DO ^DIE
KILL DIE
+18 LOCK -^DGS(41.43,DA)
+19 QUIT
+20 ;
CHKST(CODE) ; determine if status code is valid
+1 ; input -
+2 ; CODE = status of pre-registration call - this code is sent to the RPC from the Vetlink Kiosk
+3 ; output -
+4 ; FOUND = result of the validation which determines if the incoming kiosk code was matched against one of the valid VistA codes
+5 NEW LIST,VALUE,FOUND
+6 SET VALUE=""
SET FOUND=0
+7 DO BLDCODES(.LIST)
+8 FOR
SET VALUE=$ORDER(LIST(VALUE))
if VALUE=""
QUIT
if FOUND
QUIT
IF VALUE=CODE
SET FOUND=1
+9 QUIT FOUND
+10 ;
BLDCODES(ARRAY) ;build array of valid statuses that represent the outcome of the call to the patient
+1 ; valid codes can be located at the STATUS field of the PRE-REGISTRATION CALL LOG (#41.43,3).
+2 ;input/output - ARRAY passed in by reference
+3 NEW LN,LINE,STRING
+4 FOR LN=1:1
SET LINE=$TEXT(CODELST+LN)
SET STRING=$PIECE(LINE,";;",2)
if STRING=""
QUIT
SET ARRAY($PIECE(STRING,U))=""
+5 QUIT
+6 ;
CODELST ; list of codes
+1 ;;B^BUSY
+2 ;;C^CONNECTED
+3 ;;D^DEATH
+4 ;;K^CALL BACK
+5 ;;M^LEFT CALLBACK MESSAGE
+6 ;;N^NO ANSWER
+7 ;;P^NO PHONE
+8 ;;T^DON'T CALL
+9 ;;U^UNCOOPERATIVE
+10 ;;V^PREVIOUSLY UPDATED
+11 ;;W^WRONG NUMBER
+12 ;;X^CHANGE INFORMATION
+13 ;;
