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

ORQPTQ2.m

Go to the documentation of this file.
  1. ORQPTQ2 ; slc/CLA - Functions which return patient lists and list sources pt 2 ;3/14/05 10:50
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,187,190,195,215,320**;Dec 17, 1997;Build 16
  1. ;
  1. ; Ref. to ^UTILITY via IA 10061
  1. ; DBIA 4433 SDAPI^SDAMA301 ^TMP($J,"SDAMA301")
  1. ;
  1. CLIN(Y) ; RETURN LIST OF CLINICS
  1. N ORLST,IEN,I
  1. D GETLST^XPAR(.ORLST,"ALL","ORWD COMMON CLINIC")
  1. S I=0 F S I=$O(ORLST(I)) Q:'I D
  1. . S IEN=$P(ORLST(I),U,2) I $$ACTLOC^ORWU(IEN)=1 D
  1. .. S Y(I)=IEN_U_$P(^SC(IEN,0),U,1)
  1. Q
  1. ;
  1. ;The appointment list date range is designed to query for full dates,
  1. ;so when the search result exceeds 200 appointments,
  1. ;the display will end with the last appointment of the last day before the maximum was reached.
  1. CLINPTS2(Y,CLIN,ORBDATE,OREDATE) ; WRAPPER FUNCTION FOR USE BY RPC CALL ORQPT CLINIC PATIENTS
  1. N MAXAPPTS,APPTBGN,APPTEND,NUMAPPTS
  1. S MAXAPPTS=200 I ORBDATE=OREDATE S MAXAPPTS=0 ; if we only want one day, don't limit answer.
  1. D CLINPTS(.Y,CLIN,ORBDATE,OREDATE,MAXAPPTS,.APPTBGN,.APPTEND)
  1. S NUMAPPTS=$O(Y(""),-1)
  1. I MAXAPPTS,NUMAPPTS'<MAXAPPTS D
  1. . N ORI
  1. . S ORI=0 S APPTEND=$P(APPTEND,".")
  1. . F S ORI=$O(Y(ORI)) Q:'ORI D ;erase last day's appts since we assume it to be partial
  1. .. I APPTEND<$P(Y(ORI),U,4) K Y(ORI) S NUMAPPTS=NUMAPPTS-1 ;erase an appointment
  1. . S Y(MAXAPPTS+1)="^ *** UNABLE TO SHOW ALL APPOINTMENTS ***"
  1. . S Y(MAXAPPTS+2)="^ Showing the first "_NUMAPPTS_" appointments from "_$$FMTE^XLFDT(APPTBGN,"D")_" to "_$$FMTE^XLFDT(APPTEND-1,"D")
  1. . S Y(MAXAPPTS+3)="^"_$C(160)_" Modify the appointment list date range to start on "_$$FMTE^XLFDT(APPTEND,"D")_" to see additional appointments." ;add blank line
  1. . S Y(MAXAPPTS+4)="^"_$C(160)_$C(160) ;add blank line
  1. ;
  1. CLINPTS(Y,CLIN,ORBDATE,OREDATE,MAXAPPTS,APPTBGN,APPTEND) ; RETURN LIST OF PTS W/CLINIC APPT W/IN BEGINNING AND END DATES
  1. ; PKS-8/2003: Modified for new scheduling pkg APIs.
  1. I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
  1. I $$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
  1. N ORSRV,ORRESULT,ORERR,ORI,ORPT,ORPTSTAT,ORAPPT,ORCLIN,SDARRAY,NODE
  1. I $L($G(MAXAPPTS))=0 S MAXAPPTS=200
  1. S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. I ORBDATE="" S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
  1. I OREDATE="" S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
  1. ;
  1. ; Convert ORBDATE, OREDATE to FM Date/Time:
  1. D DT^DILF("T",ORBDATE,.ORBDATE,"","")
  1. D DT^DILF("T",OREDATE,.OREDATE,"","")
  1. I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
  1. S OREDATE=$P(OREDATE,".")_.5 ; Add 1/2 day to end date.
  1. ;
  1. ; *320 - use dbia 4433 instead of 3869.
  1. ;
  1. ;; IA# 3869:
  1. ;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house before starting.
  1. ;S ORRESULT=""
  1. ;S ORCLIN=+CLIN,ORFLDS="1;3;4;12",ORASTAT="R;NT",ORSTART=ORBDATE,OREND=OREDATE,ORSTAT="" ; Assign parameters.
  1. ;; ORFLDS: 1;3;4;12 = ApptDateTime;ApptStatus;IEN^PtName;PtStatus.
  1. ;D GETPLIST^SDAMA202(ORCLIN,ORFLDS,ORASTAT,ORSTART,OREND,.ORRESULT,ORSTAT) ; DBIA 3869.
  1. ;;
  1. ;; Deal with server errors:
  1. ;S ORERR=$$CLINERR^ORQRY01
  1. ;I $L(ORERR) S Y(1)=U_ORERR Q
  1. ;;
  1. ;; Reassign ^TMP array to local array:
  1. ;S (ORPT,ORI)=0,ORMAX=MAXAPPTS
  1. ;I ORRESULT'>0 S Y(1)="^No appointments." Q
  1. ;F S ORPT=$O(^TMP($J,"SDAMA202","GETPLIST",ORPT)) Q:ORPT=""!(ORI>ORMAX) D ;DBIA 3869
  1. ;.S ORI=ORI+1
  1. ;.S Y(ORI)=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,4)) ; IEN^Name.
  1. ;.S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
  1. ;.S Y(ORI)=Y(ORI)_U_$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,1)) ; App't.
  1. ;.S ORPTSTAT=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,12)) ; Pt Status.
  1. ;.S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="O":"OPT",1:"")
  1. ;.S ORHOLD=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,3)) ; Appt Status.
  1. ;.I ORPTSTAT=""&(ORHOLD="NT") S ORPTSTAT="NT" ; "No Action Taken."
  1. ;.S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
  1. ;;
  1. ;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house after finishing.
  1. ;
  1. K ^TMP($J,"SDAMA301") ; Clean house before starting.
  1. S ORRESULT=""
  1. S ORCLIN=+CLIN
  1. S SDARRAY(1)=ORBDATE_";"_OREDATE
  1. S SDARRAY(2)=+CLIN
  1. S SDARRAY(3)="R;I;NT"
  1. S SDARRAY("SORT")="P" ;no clinic index
  1. S SDARRAY("FLDS")="3;4" ;ApptStatus^IEN;PtName
  1. I MAXAPPTS S SDARRAY("MAX")=MAXAPPTS
  1. ;
  1. S ORRESULT=$$SDAPI^SDAMA301(.SDARRAY) ; DBIA 4433
  1. ;
  1. ; Deal with server errors:
  1. I ORRESULT<0 D S Y(1)=U_ORERR Q
  1. .S ORERR=""
  1. .N IDXERR S IDXERR=$O(^TMP($J,"SDAMA301","")) Q:IDXERR'>0
  1. .S ORERR=^TMP($J,"SDAMA301",IDXERR)
  1. ;
  1. ; Reassign ^TMP array to local array:
  1. S (ORPT,ORI)=0
  1. I ORRESULT'>0 S Y(1)="^No appointments." Q
  1. F S ORPT=$O(^TMP($J,"SDAMA301",ORPT)) Q:ORPT="" D
  1. .S ORAPPT=""
  1. .F S ORAPPT=$O(^TMP($J,"SDAMA301",ORPT,ORAPPT)) Q:ORAPPT="" D
  1. ..S ORI=ORI+1
  1. ..S NODE=^TMP($J,"SDAMA301",ORPT,ORAPPT)
  1. ..S Y(ORI)=$TR($P(NODE,U,4),";","^") ; IEN^Name.
  1. ..S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
  1. ..S Y(ORI)=Y(ORI)_U_ORAPPT ; App't.
  1. ..I $L($G(APPTEND))=0 S APPTEND=ORAPPT,APPTBGN=ORAPPT
  1. ..I ORAPPT>APPTEND S APPTEND=ORAPPT
  1. ..I ORAPPT<APPTBGN S APPTBGN=ORAPPT
  1. ..S ORPTSTAT=$P($P(NODE,U,3),";",1) ;appt status, will be transformed to pt status.
  1. ..S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="R":"OPT",ORPTSTAT="NT":"OPT",1:"") ; Pt Status.
  1. ..S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
  1. K ^TMP($J,"SDAMA301") ; Clean house after finishing.
  1. ;
  1. Q
  1. ;
  1. CDATRANG(ORY) ; return default start and stop dates for clinics in form start^stop
  1. N ORBDATE,OREDATE,ORSRV
  1. S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
  1. S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
  1. S ORBDATE=$S($L($G(ORBDATE)):ORBDATE,1:""),OREDATE=$S($L($G(OREDATE)):OREDATE,1:"")
  1. S ORY=$$UP^XLFSTR(ORBDATE)_"^"_$$UP^XLFSTR(OREDATE)
  1. Q
  1. PTAPPTS(Y,DFN,ORBDATE,OREDATE,CLIN) ; return appts for a patient between beginning and end dates for a clinic, if no clinic return all appointments
  1. ;I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
  1. I +$G(CLIN)>0,$$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
  1. N ERR,ERRMSG,VASD,NUM,CNT,INVDT,INT,EXT,ORSRV,VAERR K ^UTILITY("VASD",$J) S NUM=0,CNT=1 ;IA 10061
  1. I (ORBDATE="")!(OREDATE="") D ;get user's service and set up entities:
  1. .S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. I ORBDATE="" D
  1. .I '$L(CLIN) S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
  1. .S:ORBDATE="" ORBDATE="T" ;default start date across all clinics is today
  1. I OREDATE="" D
  1. .I '$L(CLIN) S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
  1. .S:OREDATE="" OREDATE="T" ;default end date across all clinics is today
  1. ;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
  1. D DT^DILF("T",ORBDATE,.ORBDATE,"","")
  1. D DT^DILF("T",OREDATE,.OREDATE,"","")
  1. I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
  1. S VASD("F")=ORBDATE
  1. S VASD("T")=$P(OREDATE,".")_.5 ;ADD 1/2 DAY TO END DATE
  1. I $L($G(CLIN)) S VASD("C",CLIN)=""
  1. D SDA^ORQRY01(.ERR,.ERRMSG)
  1. I ERR K ^UTILITY("VASD",$J) S Y(1)=ERRMSG Q
  1. F S NUM=$O(^UTILITY("VASD",$J,NUM)) Q:'NUM D
  1. .S INT=^UTILITY("VASD",$J,NUM,"I"),INVDT=9999999-$P(INT,U)
  1. .S EXT=^UTILITY("VASD",$J,NUM,"E")
  1. .S Y(CNT)=$P(INT,U)_U_$P(EXT,U,2)_U_$P(EXT,U,3)_U_$P(EXT,U,4)_U_INVDT
  1. .S CNT=CNT+1
  1. S:+$G(Y(1))<1 Y(1)="^No appointments."
  1. K ^UTILITY("VASD",$J)
  1. Q
  1. PROV(Y) ; RETURN LIST OF PROVIDERS
  1. N I,IEN,NAME,TDATE
  1. S I=1,NAME=""
  1. F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" S IEN=0,IEN=$O(^(NAME,IEN)) D
  1. .Q:$E(NAME)="*"
  1. .I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) S Y(I)=IEN_"^"_NAME,I=I+1
  1. Q
  1. PROVPTS(Y,PROV) ; RETURN LIST OF PATIENTS LINKED TO A PRIMARY PROVIDER
  1. I +$G(PROV)<1 S Y(1)="^No provider identified" Q
  1. N ORI,DFN
  1. S ORI=1,DFN=0
  1. F S DFN=$O(^DPT("APR",PROV,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
  1. S:+$G(Y(1))<1 Y(1)="^No patients found."
  1. Q
  1. SPEC(Y) ; RETURN LIST OF TREATING SPECIALTIES
  1. N I,NAME,IEN
  1. S I=1,NAME=""
  1. ;access to DIC(45.7 global granted under DBIA #519:
  1. F S NAME=$O(^DIC(45.7,"B",NAME)) Q:NAME="" S IEN=0,IEN=$O(^(NAME,IEN)) I $$ACTIVE^DGACT(45.7,IEN) S Y(I)=IEN_"^"_NAME,I=I+1
  1. Q
  1. SPECPTS(Y,SPEC) ; RETURN LIST OF PATIENTS LINKED TO A TREATING SPECIALTY
  1. I +$G(SPEC)<1 S Y(1)="^No specialty identified" Q
  1. N ORI,DFN
  1. S ORI=1,DFN=0
  1. F S DFN=$O(^DPT("ATR",SPEC,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
  1. S:+$G(Y(1))<1 Y(1)="^No patients found."
  1. Q
  1. WARD(Y) ; RETURN LIST OF ACTIVE WARDS
  1. N I,IEN,NAME,D0
  1. S I=1,NAME=""
  1. ;access to DIC(42 global granted under DBIA #36:
  1. F S NAME=$O(^DIC(42,"B",NAME)) Q:NAME="" S IEN=$O(^(NAME,0)) D
  1. . S D0=IEN D WIN^DGPMDDCF
  1. . I X=0 S Y(I)=IEN_"^"_NAME,I=I+1
  1. Q
  1. WARDPTS(Y,WARD) ; RETURN LIST OF PATIENTS IN A WARD
  1. ; SLC/PKS - Modifications for Room/Bed data on 1/19/2001.
  1. I +$G(WARD)<1 S Y(1)="^No ward identified" Q
  1. N ORI,DFN,RBDAT
  1. S ORI=1,DFN=0
  1. ; Access to DIC(42 global granted under DBIA #36:
  1. S WARD=$P(^DIC(42,WARD,0),"^") ;GET WARD NAME FOR "CN" LOOKUP
  1. ; Next section modified 1/19/2001 by PKS:
  1. F D Q:DFN'>0
  1. .S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0
  1. .S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^")
  1. .S RBDAT=""
  1. .; Add patient room/bed information where data exists:
  1. .S RBDAT=$P($G(^DPT(+DFN,.101)),U)
  1. .I RBDAT'="" D ; Any R/B data?
  1. ..I $L(RBDAT)<4 S RBDAT=RBDAT_" " ; Add if < 4 chars.
  1. ..S RBDAT=$E(RBDAT,1,4) ; Get first 4 only.
  1. .S Y(ORI)=Y(ORI)_U_RBDAT ; Add R/B to string
  1. .S ORI=ORI+1 ; Increment counter.
  1. ;
  1. S:+$G(Y(1))<1 Y(1)="^No patients found."
  1. Q
  1. NLIST(ORQY) ; return a null list
  1. S ORQY(1)=""
  1. Q