VPSRPC5 ;DALOI/KML - Utilities ;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
;
GETSITES(RETURN,VPSSN) ; CSW this is the new routine replacing the original
; Input:
; RETURN - passed in by reference; return value populated with the listof site ids visited by PATIENT (DFN)
; VPSSN - patient SSN
; Output:
; RETURN - array of site IDs obtained from the TREATING FACILITY LIST file (391.91).
K RETURN,VPSDFN
I '+$G(VPSSN) S RETURN(1)="99^PATIENT SSN not sent" Q
D GETDFN(.VPSDFN,VPSSN)
I $P(VPSDFN,U)=99 S RETURN=VPSDFN Q
S VPSDFN=$P(VPSDFN,U,2)
N VPSIEN,VPSCNT,VPSID,VPSNM
D TFL^VAFCTFU1(.RETURN,VPSDFN) ;IA2990 (supported)
I $D(RETURN),$P(RETURN(1),"^")'>0 S RETURN(1)="99^Patient has not been treated at any other site" Q
Q
;
GETDFN(RETURN,VPSSN) ;
;Input:
; RETURN - passed in by reference; return value populated with associated patient DFN
; VPSSN - patient social security number
; Output:
; RETURN - success - "1^_DFN
; exception - "99^"_exception text
;
; External Reference IA#
; ------------------------
;#10035 - ^DPT( reference (Supported)
;
K RETURN
N VPSDFN
I $G(VPSSN)="" S RETURN="99^SSN NOT SENT." Q
S VPSSN=$TR(VPSSN,"- ")
I +$G(VPSSN)'>0 S RETURN="99^SSN SHOULD BE NUMERIC: "_VPSSN Q
S VPSDFN=$O(^DPT("SSN",VPSSN,0))
I +$G(VPSDFN)'>0 S RETURN="99^NO PATIENT FOUND WITH SSN: "_VPSSN Q
S RETURN="1^"_VPSDFN
Q
;
LAST5(LST,VPSID) ; Return a list of patients matching A9999 identifiers
N I,IEN,XREF
S (I,IEN)=0,XREF=$S($L(VPSID)=5:"BS5",1:"BS")
F S IEN=$O(^DPT(XREF,VPSID,IEN)) Q:'IEN D
. S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249,ICR5839
Q
FULLSSN(LST,VPSID) ; Return a list of patients matching full SSN entered
N I,IEN
S (I,IEN)=0
F S IEN=$O(^DPT("SSN",VPSID,IEN)) Q:'IEN D
. S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249,ICR5839
Q
;
LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
N I,IEN,CNT,FROMIEN,ORIDNAME S CNT=50,I=0,FROMIEN=0
I $P(FROM,U,2)'="" S FROMIEN=$P(FROM,U,1),FROM=$O(^DPT("B",$P(FROM,U,2)),-DIR)
F S FROM=$O(^DPT("B",FROM),DIR) Q:FROM="" D Q:I=CNT
. S IEN=FROMIEN,FROMIEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT
. . S ORIDNAME=""
. . S ORIDNAME=$G(^DPT(IEN,0)) ; Get zero node name.
. . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101))
. . S I=I+1 S Y(I)=IEN_U_FROM_U_U_U_U_$P(ORIDNAME,U) ;_"^"_X ; _"^"_X1 ;" ("_X_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSRPC5 2642 printed Dec 13, 2024@02:43:36 Page 2
VPSRPC5 ;DALOI/KML - Utilities ;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 QUIT
+4 ;
GETSITES(RETURN,VPSSN) ; CSW this is the new routine replacing the original
+1 ; Input:
+2 ; RETURN - passed in by reference; return value populated with the listof site ids visited by PATIENT (DFN)
+3 ; VPSSN - patient SSN
+4 ; Output:
+5 ; RETURN - array of site IDs obtained from the TREATING FACILITY LIST file (391.91).
+6 KILL RETURN,VPSDFN
+7 IF '+$GET(VPSSN)
SET RETURN(1)="99^PATIENT SSN not sent"
QUIT
+8 DO GETDFN(.VPSDFN,VPSSN)
+9 IF $PIECE(VPSDFN,U)=99
SET RETURN=VPSDFN
QUIT
+10 SET VPSDFN=$PIECE(VPSDFN,U,2)
+11 NEW VPSIEN,VPSCNT,VPSID,VPSNM
+12 ;IA2990 (supported)
DO TFL^VAFCTFU1(.RETURN,VPSDFN)
+13 IF $DATA(RETURN)
IF $PIECE(RETURN(1),"^")'>0
SET RETURN(1)="99^Patient has not been treated at any other site"
QUIT
+14 QUIT
+15 ;
GETDFN(RETURN,VPSSN) ;
+1 ;Input:
+2 ; RETURN - passed in by reference; return value populated with associated patient DFN
+3 ; VPSSN - patient social security number
+4 ; Output:
+5 ; RETURN - success - "1^_DFN
+6 ; exception - "99^"_exception text
+7 ;
+8 ; External Reference IA#
+9 ; ------------------------
+10 ;#10035 - ^DPT( reference (Supported)
+11 ;
+12 KILL RETURN
+13 NEW VPSDFN
+14 IF $GET(VPSSN)=""
SET RETURN="99^SSN NOT SENT."
QUIT
+15 SET VPSSN=$TRANSLATE(VPSSN,"- ")
+16 IF +$GET(VPSSN)'>0
SET RETURN="99^SSN SHOULD BE NUMERIC: "_VPSSN
QUIT
+17 SET VPSDFN=$ORDER(^DPT("SSN",VPSSN,0))
+18 IF +$GET(VPSDFN)'>0
SET RETURN="99^NO PATIENT FOUND WITH SSN: "_VPSSN
QUIT
+19 SET RETURN="1^"_VPSDFN
+20 QUIT
+21 ;
LAST5(LST,VPSID) ; Return a list of patients matching A9999 identifiers
+1 NEW I,IEN,XREF
+2 SET (I,IEN)=0
SET XREF=$SELECT($LENGTH(VPSID)=5:"BS5",1:"BS")
+3 FOR
SET IEN=$ORDER(^DPT(XREF,VPSID,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 ; DG249,ICR5839
SET I=I+1
SET LST(I)=IEN_U_$PIECE(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)
End DoDot:1
+5 QUIT
FULLSSN(LST,VPSID) ; Return a list of patients matching full SSN entered
+1 NEW I,IEN
+2 SET (I,IEN)=0
+3 FOR
SET IEN=$ORDER(^DPT("SSN",VPSID,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 ; DG249,ICR5839
SET I=I+1
SET LST(I)=IEN_U_$PIECE(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)
End DoDot:1
+5 QUIT
+6 ;
LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
+1 NEW I,IEN,CNT,FROMIEN,ORIDNAME
SET CNT=50
SET I=0
SET FROMIEN=0
+2 IF $PIECE(FROM,U,2)'=""
SET FROMIEN=$PIECE(FROM,U,1)
SET FROM=$ORDER(^DPT("B",$PIECE(FROM,U,2)),-DIR)
+3 FOR
SET FROM=$ORDER(^DPT("B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=FROMIEN
SET FROMIEN=0
FOR
SET IEN=$ORDER(^DPT("B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+5 SET ORIDNAME=""
+6 ; Get zero node name.
SET ORIDNAME=$GET(^DPT(IEN,0))
+7 ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101))
+8 ;_"^"_X ; _"^"_X1 ;" ("_X_")"
SET I=I+1
SET Y(I)=IEN_U_FROM_U_U_U_U_$PIECE(ORIDNAME,U)
End DoDot:2
if I=CNT
QUIT
End DoDot:1
if I=CNT
QUIT
+9 QUIT
