- 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 Feb 19, 2025@00:10:03 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