Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSRPC5

VPSRPC5.m

Go to the documentation of this file.
  1. VPSRPC5 ;DALOI/KML - Utilities ;4/26/2012
  1. ;;1.0;VA POINT OF SERVICE (KIOSKS);**2**;Oct 21, 2011;Build 41
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. GETSITES(RETURN,VPSSN) ; CSW this is the new routine replacing the original
  1. ; Input:
  1. ; RETURN - passed in by reference; return value populated with the listof site ids visited by PATIENT (DFN)
  1. ; VPSSN - patient SSN
  1. ; Output:
  1. ; RETURN - array of site IDs obtained from the TREATING FACILITY LIST file (391.91).
  1. K RETURN,VPSDFN
  1. I '+$G(VPSSN) S RETURN(1)="99^PATIENT SSN not sent" Q
  1. D GETDFN(.VPSDFN,VPSSN)
  1. I $P(VPSDFN,U)=99 S RETURN=VPSDFN Q
  1. S VPSDFN=$P(VPSDFN,U,2)
  1. N VPSIEN,VPSCNT,VPSID,VPSNM
  1. D TFL^VAFCTFU1(.RETURN,VPSDFN) ;IA2990 (supported)
  1. I $D(RETURN),$P(RETURN(1),"^")'>0 S RETURN(1)="99^Patient has not been treated at any other site" Q
  1. Q
  1. ;
  1. GETDFN(RETURN,VPSSN) ;
  1. ;Input:
  1. ; RETURN - passed in by reference; return value populated with associated patient DFN
  1. ; VPSSN - patient social security number
  1. ; Output:
  1. ; RETURN - success - "1^_DFN
  1. ; exception - "99^"_exception text
  1. ;
  1. ; External Reference IA#
  1. ; ------------------------
  1. ;#10035 - ^DPT( reference (Supported)
  1. ;
  1. K RETURN
  1. N VPSDFN
  1. I $G(VPSSN)="" S RETURN="99^SSN NOT SENT." Q
  1. S VPSSN=$TR(VPSSN,"- ")
  1. I +$G(VPSSN)'>0 S RETURN="99^SSN SHOULD BE NUMERIC: "_VPSSN Q
  1. S VPSDFN=$O(^DPT("SSN",VPSSN,0))
  1. I +$G(VPSDFN)'>0 S RETURN="99^NO PATIENT FOUND WITH SSN: "_VPSSN Q
  1. S RETURN="1^"_VPSDFN
  1. Q
  1. ;
  1. LAST5(LST,VPSID) ; Return a list of patients matching A9999 identifiers
  1. N I,IEN,XREF
  1. S (I,IEN)=0,XREF=$S($L(VPSID)=5:"BS5",1:"BS")
  1. F S IEN=$O(^DPT(XREF,VPSID,IEN)) Q:'IEN D
  1. . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249,ICR5839
  1. Q
  1. FULLSSN(LST,VPSID) ; Return a list of patients matching full SSN entered
  1. N I,IEN
  1. S (I,IEN)=0
  1. F S IEN=$O(^DPT("SSN",VPSID,IEN)) Q:'IEN D
  1. . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249,ICR5839
  1. Q
  1. ;
  1. LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
  1. N I,IEN,CNT,FROMIEN,ORIDNAME S CNT=50,I=0,FROMIEN=0
  1. I $P(FROM,U,2)'="" S FROMIEN=$P(FROM,U,1),FROM=$O(^DPT("B",$P(FROM,U,2)),-DIR)
  1. F S FROM=$O(^DPT("B",FROM),DIR) Q:FROM="" D Q:I=CNT
  1. . S IEN=FROMIEN,FROMIEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT
  1. . . S ORIDNAME=""
  1. . . S ORIDNAME=$G(^DPT(IEN,0)) ; Get zero node name.
  1. . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101))
  1. . . S I=I+1 S Y(I)=IEN_U_FROM_U_U_U_U_$P(ORIDNAME,U) ;_"^"_X ; _"^"_X1 ;" ("_X_")"
  1. Q