- 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 Jan 18, 2025@03:44:41 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 ;;