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

VBECLU0.m

Go to the documentation of this file.
  1. VBECLU0 ;HOIFO/BNT - VBECS Patient Lookup Utility ;
  1. ;;2.0;VBEC;**1**;Jun 05, 2015;Build 13
  1. ;
  1. ; Note: This routine supports data exchange with an FDA registered
  1. ; medical device. As such, it may not be changed in any way without
  1. ; prior written approval from the medical device manufacturer.
  1. ;
  1. ; Integration Agreements:
  1. ;
  1. SET X="You Can't Enter VBECLU0 at top of routine!"
  1. QUIT
  1. ;
  1. BYFILTER(FILTER,FILTERV,BDATE,EDATE,SEARCH,VALUE,DELIM) ; -- search type by clinic, provider, or ward.
  1. NEW PCNT,OKAY,VAL
  1. K ^TMP("PTLKUP",$J)
  1. SET (OKAY,PCNT)=0
  1. ;W:$D(ALAN(1)) !,"In ByFilter"
  1. ;
  1. DO ADD^VBECLU("<record count='0'>")
  1. SET LINENO=VBECLINE
  1. FOR I=1:1 S VAL=$P(FILTERV,DELIM,I) QUIT:VAL="" DO Q:$$STOP^XOBVLIB()
  1. . IF FILTER="WARD" DO WARDPTS(VAL) S OKAY=1 Q
  1. . IF FILTER="CLINIC" DO CLINPTS(VAL,BDATE,EDATE) S OKAY=2 Q
  1. . IF FILTER="PROVIDER" D PROVPTS(VAL) S OKAY=3 Q
  1. ;
  1. IF OKAY<1 DO ADD^VBECLU("<error message='Filter not correctly specified'></error>")
  1. ;
  1. ; -- update the record count
  1. DO ADDPTS()
  1. SET @VBECRSLT@(LINENO)="<record count='"_PCNT_"'>"
  1. IF ($G(MAXSIZRE)<1) DO ADD^VBECLU("<maximum message=''></maximum>")
  1. DO ADD^VBECLU("<error message=''></error>")
  1. QUIT
  1. ;
  1. FILTCHK(DFN,TYPE,VALUE) ; -- Filter search -
  1. ; -- check patients to match search type and search value for filter searchs
  1. ; -- returns 1 if matchs, 0 if no match
  1. ;
  1. ;W:$D(ALAN(1)) !,"In FilterCheck"
  1. SET VALUE=$$UP^XLFSTR(VALUE)
  1. Q:($G(VALUE)="")!($G(VALUE)="*") 1
  1. Q:($G(TYPE)="") 1
  1. Q:($G(DFN)<1) 0
  1. ;
  1. NEW I,J,OKAY
  1. SET OKAY=0
  1. IF TYPE="NAME" DO
  1. . SET CHKVAL=$P($G(^DPT(DFN,0)),"^",1)
  1. . IF $E(CHKVAL,1,$LENGTH(VALUE))=VALUE SET OKAY=1
  1. IF TYPE="SSN" DO
  1. . SET CHKVAL=$P($G(^DPT(DFN,0)),"^",9)
  1. . IF $E(CHKVAL,1,$LENGTH(VALUE))=VALUE SET OKAY=1
  1. IF TYPE="ICN" DO
  1. . SET CHKVAL=$P($G(^DPT(DFN,"MPI")),"^",1)
  1. . IF $E(CHKVAL,1,$LENGTH(VALUE))=VALUE SET OKAY=1
  1. IF TYPE="SSN4" DO
  1. . SET CHKVAL=$E($P($G(^DPT(DFN,0)),"^",1),1)_$E($P($G(^DPT(DFN,0)),"^",9),6,9)
  1. . IF $E(CHKVAL,1,$LENGTH(VALUE))=VALUE SET OKAY=1
  1. QUIT OKAY
  1. ;
  1. WARDPTS(WARD) ; RETURN LIST OF PATIENTS IN A WARD
  1. ; Based on ORQPTQ2
  1. Q:+$G(WARD)<1
  1. N DFN
  1. S DFN=0
  1. S WARD=$P(^DIC(42,WARD,0),"^") ;GET WARD NAME FOR "CN" LOOKUP
  1. Q:WARD=""
  1. F D Q:DFN'>0 Q:$$STOP^XOBVLIB()
  1. . S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0
  1. . Q:'$$FILTCHK(DFN,SEARCH,VALUE)
  1. . S ^TMP("PTLKUP",$J,$P($G(^DPT(DFN,0)),"^",1),DFN)=""
  1. Q
  1. ;
  1. PROVPTS(PROV) ; RETURN LIST OF PATIENTS LINKED TO A PRIMARY PROVIDER
  1. ; Based on ORQPTQ2
  1. ; "APR" xref is on field PROVIDER in file 2 (2;.104)
  1. ; "AAP" xref is on field ATTENDING PHYSICIAN in file 2 (2;.1041)
  1. ;
  1. Q:+$G(PROV)<1
  1. ;
  1. N DFN,XREF
  1. S DFN=0
  1. F XREF="AAP","APR" DO
  1. . F S DFN=$O(^DPT(XREF,PROV,DFN)) Q:DFN'>0 D Q:$$STOP^XOBVLIB()
  1. .. Q:'$$FILTCHK(DFN,SEARCH,VALUE)
  1. .. S ^TMP("PTLKUP",$J,$P($G(^DPT(DFN,0)),"^",1),DFN)=""
  1. Q
  1. ;
  1. CLINPTS(CLIN,BDATE,EDATE) ; RETURN LIST OF PTS W/CLINIC APPT W/IN BEGINNING AND END DATES
  1. Q:+$G(CLIN)<1
  1. ;
  1. N DFN,NAME,I,J,X,ORJ,ORSRV,ORNOWDT,CHKX,CHKIN,MAXAPPTS,ORC,CLNAM
  1. S MAXAPPTS=200
  1. S NOWDT=$$NOW^XLFDT
  1. ;
  1. S DFN=0,I=1
  1. IF $G(BDATE)="" S BDATE="T"
  1. IF $G(EDATE)="" S EDATE="T+1"
  1. ;CONVERT BDATE AND EDATE INTO FILEMAN DATE/TIME
  1. D DT^DILF("T",BDATE,.BDATE,"","")
  1. D DT^DILF("T",EDATE,.EDATE,"","")
  1. I (BDATE=-1)!(EDATE=-1) S Y(1)="^Error in date range." Q
  1. S EDATE=$P(EDATE,".")_.5 ;ADD 1/2 DAY TO END DATE
  1. ;
  1. D CLINPT2(+CLIN,BDATE,EDATE)
  1. QUIT
  1. ;
  1. CLINPT2(CLIN,BEGIN,END) ; -- Use scheduling rehosting API from patches SD*5.3*253 and SD*5.3*275
  1. ; -- GETPLIST^SDAMA202(SDIEN,SDFIELDS,SDAPSTAT,SDSTART,SDEND,.SDRESULT,SDIOSTAT)
  1. ;
  1. K ^TMP($J,"SDAMA202","GETPLIST")
  1. NEW I,X,APPTS SET APPTS=""
  1. ;
  1. ; -- get appointment date/time, patient status, patient ien & name,
  1. ; only get appointment status = "R" for scheduled or kept appointments.
  1. DO GETPLIST^SDAMA202(+CLIN,"1;3;4","R",BEGIN,END,.APPTS)
  1. ;
  1. ; -- check number of appointments
  1. Q:APPTS<1
  1. ;
  1. ; -- check for an error, may need to pass message up.
  1. I $D(^TMP($J,"SDAMA202","GETPTLIST","ERROR")) QUIT
  1. ;
  1. ; -- move list of appointments to list of patients, ordered by name, dfn
  1. S (I,X)=""
  1. F SET I=$O(^TMP($J,"SDAMA202","GETPLIST",I)) Q:I<1 S X=^(I,4) DO
  1. . Q:'$$FILTCHK(+X,SEARCH,VALUE) ;check if meets search criteria
  1. . S ^TMP("PTLKUP",$J,$P(X,"^",2),+X)=""
  1. QUIT
  1. ;
  1. ADDPTS() ;
  1. N NAME,DFN
  1. S NAME=""
  1. FOR SET NAME=$O(^TMP("PTLKUP",$J,NAME)) Q:NAME="" DO
  1. . S DFN="" FOR SET DFN=$O(^TMP("PTLKUP",$J,NAME,DFN)) Q:DFN<1 DO
  1. .. DO PTDATA^VBECLU(DFN,.PCNT)
  1. ;IF ($G(MAXSIZRE)<1) DO ADD^VBECLU("<maximum message=''></maximum>")
  1. Q
  1. ;
  1. NAMECOMP(DFN) ; ENTRY IS +$P($G(^DPT(DFN,"NAME")),"^",1)
  1. N A,LN,FN,MI,PR,SU,DE
  1. S A=$G(^VA(20,+$P($G(^DPT(DFN,"NAME")),"^",1),1))
  1. S LN=$$CHARCHK^XOBVLIB($P(A,"^",1))
  1. S FN=$$CHARCHK^XOBVLIB($P(A,"^",2))
  1. S MI=$$CHARCHK^XOBVLIB($P(A,"^",3))
  1. S PR=$$CHARCHK^XOBVLIB($P(A,"^",4))
  1. S SU=$$CHARCHK^XOBVLIB($P(A,"^",5))
  1. S DE=$$CHARCHK^XOBVLIB($P(A,"^",6))
  1. DO ADD^VBECLU("<CmpntLastName>"_LN_"</CmpntLastName><CmpntFirstName>"_FN_"</CmpntFirstName><CmpntMiddleName>"_MI_"</CmpntMiddleName><CmpntPrefx>"_PR_"</CmpntPrefx><PatientNameSuffix>"_SU_"</PatientNameSuffix><CmpntDgr>"_DE_"</CmpntDgr>")
  1. ;