ORQPTQ2 ; slc/CLA - Functions which return patient lists and list sources pt 2 ;3/14/05 10:50
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,187,190,195,215,320**;Dec 17, 1997;Build 16
;
; Ref. to ^UTILITY via IA 10061
; DBIA 4433 SDAPI^SDAMA301 ^TMP($J,"SDAMA301")
;
CLIN(Y) ; RETURN LIST OF CLINICS
N ORLST,IEN,I
D GETLST^XPAR(.ORLST,"ALL","ORWD COMMON CLINIC")
S I=0 F S I=$O(ORLST(I)) Q:'I D
. S IEN=$P(ORLST(I),U,2) I $$ACTLOC^ORWU(IEN)=1 D
.. S Y(I)=IEN_U_$P(^SC(IEN,0),U,1)
Q
;
;The appointment list date range is designed to query for full dates,
;so when the search result exceeds 200 appointments,
;the display will end with the last appointment of the last day before the maximum was reached.
CLINPTS2(Y,CLIN,ORBDATE,OREDATE) ; WRAPPER FUNCTION FOR USE BY RPC CALL ORQPT CLINIC PATIENTS
N MAXAPPTS,APPTBGN,APPTEND,NUMAPPTS
S MAXAPPTS=200 I ORBDATE=OREDATE S MAXAPPTS=0 ; if we only want one day, don't limit answer.
D CLINPTS(.Y,CLIN,ORBDATE,OREDATE,MAXAPPTS,.APPTBGN,.APPTEND)
S NUMAPPTS=$O(Y(""),-1)
I MAXAPPTS,NUMAPPTS'<MAXAPPTS D
. N ORI
. S ORI=0 S APPTEND=$P(APPTEND,".")
. F S ORI=$O(Y(ORI)) Q:'ORI D ;erase last day's appts since we assume it to be partial
.. I APPTEND<$P(Y(ORI),U,4) K Y(ORI) S NUMAPPTS=NUMAPPTS-1 ;erase an appointment
. S Y(MAXAPPTS+1)="^ *** UNABLE TO SHOW ALL APPOINTMENTS ***"
. S Y(MAXAPPTS+2)="^ Showing the first "_NUMAPPTS_" appointments from "_$$FMTE^XLFDT(APPTBGN,"D")_" to "_$$FMTE^XLFDT(APPTEND-1,"D")
. 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
. S Y(MAXAPPTS+4)="^"_$C(160)_$C(160) ;add blank line
;
CLINPTS(Y,CLIN,ORBDATE,OREDATE,MAXAPPTS,APPTBGN,APPTEND) ; RETURN LIST OF PTS W/CLINIC APPT W/IN BEGINNING AND END DATES
; PKS-8/2003: Modified for new scheduling pkg APIs.
I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
I $$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
N ORSRV,ORRESULT,ORERR,ORI,ORPT,ORPTSTAT,ORAPPT,ORCLIN,SDARRAY,NODE
I $L($G(MAXAPPTS))=0 S MAXAPPTS=200
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
I ORBDATE="" S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
I OREDATE="" S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
;
; Convert ORBDATE, OREDATE to FM Date/Time:
D DT^DILF("T",ORBDATE,.ORBDATE,"","")
D DT^DILF("T",OREDATE,.OREDATE,"","")
I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
S OREDATE=$P(OREDATE,".")_.5 ; Add 1/2 day to end date.
;
; *320 - use dbia 4433 instead of 3869.
;
;; IA# 3869:
;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house before starting.
;S ORRESULT=""
;S ORCLIN=+CLIN,ORFLDS="1;3;4;12",ORASTAT="R;NT",ORSTART=ORBDATE,OREND=OREDATE,ORSTAT="" ; Assign parameters.
;; ORFLDS: 1;3;4;12 = ApptDateTime;ApptStatus;IEN^PtName;PtStatus.
;D GETPLIST^SDAMA202(ORCLIN,ORFLDS,ORASTAT,ORSTART,OREND,.ORRESULT,ORSTAT) ; DBIA 3869.
;;
;; Deal with server errors:
;S ORERR=$$CLINERR^ORQRY01
;I $L(ORERR) S Y(1)=U_ORERR Q
;;
;; Reassign ^TMP array to local array:
;S (ORPT,ORI)=0,ORMAX=MAXAPPTS
;I ORRESULT'>0 S Y(1)="^No appointments." Q
;F S ORPT=$O(^TMP($J,"SDAMA202","GETPLIST",ORPT)) Q:ORPT=""!(ORI>ORMAX) D ;DBIA 3869
;.S ORI=ORI+1
;.S Y(ORI)=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,4)) ; IEN^Name.
;.S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
;.S Y(ORI)=Y(ORI)_U_$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,1)) ; App't.
;.S ORPTSTAT=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,12)) ; Pt Status.
;.S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="O":"OPT",1:"")
;.S ORHOLD=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,3)) ; Appt Status.
;.I ORPTSTAT=""&(ORHOLD="NT") S ORPTSTAT="NT" ; "No Action Taken."
;.S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
;;
;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house after finishing.
;
K ^TMP($J,"SDAMA301") ; Clean house before starting.
S ORRESULT=""
S ORCLIN=+CLIN
S SDARRAY(1)=ORBDATE_";"_OREDATE
S SDARRAY(2)=+CLIN
S SDARRAY(3)="R;I;NT"
S SDARRAY("SORT")="P" ;no clinic index
S SDARRAY("FLDS")="3;4" ;ApptStatus^IEN;PtName
I MAXAPPTS S SDARRAY("MAX")=MAXAPPTS
;
S ORRESULT=$$SDAPI^SDAMA301(.SDARRAY) ; DBIA 4433
;
; Deal with server errors:
I ORRESULT<0 D S Y(1)=U_ORERR Q
.S ORERR=""
.N IDXERR S IDXERR=$O(^TMP($J,"SDAMA301","")) Q:IDXERR'>0
.S ORERR=^TMP($J,"SDAMA301",IDXERR)
;
; Reassign ^TMP array to local array:
S (ORPT,ORI)=0
I ORRESULT'>0 S Y(1)="^No appointments." Q
F S ORPT=$O(^TMP($J,"SDAMA301",ORPT)) Q:ORPT="" D
.S ORAPPT=""
.F S ORAPPT=$O(^TMP($J,"SDAMA301",ORPT,ORAPPT)) Q:ORAPPT="" D
..S ORI=ORI+1
..S NODE=^TMP($J,"SDAMA301",ORPT,ORAPPT)
..S Y(ORI)=$TR($P(NODE,U,4),";","^") ; IEN^Name.
..S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
..S Y(ORI)=Y(ORI)_U_ORAPPT ; App't.
..I $L($G(APPTEND))=0 S APPTEND=ORAPPT,APPTBGN=ORAPPT
..I ORAPPT>APPTEND S APPTEND=ORAPPT
..I ORAPPT<APPTBGN S APPTBGN=ORAPPT
..S ORPTSTAT=$P($P(NODE,U,3),";",1) ;appt status, will be transformed to pt status.
..S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="R":"OPT",ORPTSTAT="NT":"OPT",1:"") ; Pt Status.
..S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
K ^TMP($J,"SDAMA301") ; Clean house after finishing.
;
Q
;
CDATRANG(ORY) ; return default start and stop dates for clinics in form start^stop
N ORBDATE,OREDATE,ORSRV
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
S ORBDATE=$S($L($G(ORBDATE)):ORBDATE,1:""),OREDATE=$S($L($G(OREDATE)):OREDATE,1:"")
S ORY=$$UP^XLFSTR(ORBDATE)_"^"_$$UP^XLFSTR(OREDATE)
Q
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
;I +$G(CLIN)<1 S Y(1)="^No clinic identified" Q
I +$G(CLIN)>0,$$ACTLOC^ORWU(CLIN)'=1 S Y(1)="^Clinic is inactive or Occasion Of Service" Q
N ERR,ERRMSG,VASD,NUM,CNT,INVDT,INT,EXT,ORSRV,VAERR K ^UTILITY("VASD",$J) S NUM=0,CNT=1 ;IA 10061
I (ORBDATE="")!(OREDATE="") D ;get user's service and set up entities:
.S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
I ORBDATE="" D
.I '$L(CLIN) S ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
.S:ORBDATE="" ORBDATE="T" ;default start date across all clinics is today
I OREDATE="" D
.I '$L(CLIN) S OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
.S:OREDATE="" OREDATE="T" ;default end date across all clinics is today
;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
D DT^DILF("T",ORBDATE,.ORBDATE,"","")
D DT^DILF("T",OREDATE,.OREDATE,"","")
I (ORBDATE=-1)!(OREDATE=-1) S Y(1)="^Error in date range." Q
S VASD("F")=ORBDATE
S VASD("T")=$P(OREDATE,".")_.5 ;ADD 1/2 DAY TO END DATE
I $L($G(CLIN)) S VASD("C",CLIN)=""
D SDA^ORQRY01(.ERR,.ERRMSG)
I ERR K ^UTILITY("VASD",$J) S Y(1)=ERRMSG Q
F S NUM=$O(^UTILITY("VASD",$J,NUM)) Q:'NUM D
.S INT=^UTILITY("VASD",$J,NUM,"I"),INVDT=9999999-$P(INT,U)
.S EXT=^UTILITY("VASD",$J,NUM,"E")
.S Y(CNT)=$P(INT,U)_U_$P(EXT,U,2)_U_$P(EXT,U,3)_U_$P(EXT,U,4)_U_INVDT
.S CNT=CNT+1
S:+$G(Y(1))<1 Y(1)="^No appointments."
K ^UTILITY("VASD",$J)
Q
PROV(Y) ; RETURN LIST OF PROVIDERS
N I,IEN,NAME,TDATE
S I=1,NAME=""
F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" S IEN=0,IEN=$O(^(NAME,IEN)) D
.Q:$E(NAME)="*"
.I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) S Y(I)=IEN_"^"_NAME,I=I+1
Q
PROVPTS(Y,PROV) ; RETURN LIST OF PATIENTS LINKED TO A PRIMARY PROVIDER
I +$G(PROV)<1 S Y(1)="^No provider identified" Q
N ORI,DFN
S ORI=1,DFN=0
F S DFN=$O(^DPT("APR",PROV,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
S:+$G(Y(1))<1 Y(1)="^No patients found."
Q
SPEC(Y) ; RETURN LIST OF TREATING SPECIALTIES
N I,NAME,IEN
S I=1,NAME=""
;access to DIC(45.7 global granted under DBIA #519:
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
Q
SPECPTS(Y,SPEC) ; RETURN LIST OF PATIENTS LINKED TO A TREATING SPECIALTY
I +$G(SPEC)<1 S Y(1)="^No specialty identified" Q
N ORI,DFN
S ORI=1,DFN=0
F S DFN=$O(^DPT("ATR",SPEC,DFN)) Q:DFN'>0 S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^"),ORI=ORI+1
S:+$G(Y(1))<1 Y(1)="^No patients found."
Q
WARD(Y) ; RETURN LIST OF ACTIVE WARDS
N I,IEN,NAME,D0
S I=1,NAME=""
;access to DIC(42 global granted under DBIA #36:
F S NAME=$O(^DIC(42,"B",NAME)) Q:NAME="" S IEN=$O(^(NAME,0)) D
. S D0=IEN D WIN^DGPMDDCF
. I X=0 S Y(I)=IEN_"^"_NAME,I=I+1
Q
WARDPTS(Y,WARD) ; RETURN LIST OF PATIENTS IN A WARD
; SLC/PKS - Modifications for Room/Bed data on 1/19/2001.
I +$G(WARD)<1 S Y(1)="^No ward identified" Q
N ORI,DFN,RBDAT
S ORI=1,DFN=0
; Access to DIC(42 global granted under DBIA #36:
S WARD=$P(^DIC(42,WARD,0),"^") ;GET WARD NAME FOR "CN" LOOKUP
; Next section modified 1/19/2001 by PKS:
F D Q:DFN'>0
.S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0
.S Y(ORI)=+DFN_"^"_$P(^DPT(+DFN,0),"^")
.S RBDAT=""
.; Add patient room/bed information where data exists:
.S RBDAT=$P($G(^DPT(+DFN,.101)),U)
.I RBDAT'="" D ; Any R/B data?
..I $L(RBDAT)<4 S RBDAT=RBDAT_" " ; Add if < 4 chars.
..S RBDAT=$E(RBDAT,1,4) ; Get first 4 only.
.S Y(ORI)=Y(ORI)_U_RBDAT ; Add R/B to string
.S ORI=ORI+1 ; Increment counter.
;
S:+$G(Y(1))<1 Y(1)="^No patients found."
Q
NLIST(ORQY) ; return a null list
S ORQY(1)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ2 10064 printed Oct 16, 2024@18:34:02 Page 2
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
+2 ;
+3 ; Ref. to ^UTILITY via IA 10061
+4 ; DBIA 4433 SDAPI^SDAMA301 ^TMP($J,"SDAMA301")
+5 ;
CLIN(Y) ; RETURN LIST OF CLINICS
+1 NEW ORLST,IEN,I
+2 DO GETLST^XPAR(.ORLST,"ALL","ORWD COMMON CLINIC")
+3 SET I=0
FOR
SET I=$ORDER(ORLST(I))
if 'I
QUIT
Begin DoDot:1
+4 SET IEN=$PIECE(ORLST(I),U,2)
IF $$ACTLOC^ORWU(IEN)=1
Begin DoDot:2
+5 SET Y(I)=IEN_U_$PIECE(^SC(IEN,0),U,1)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
+8 ;The appointment list date range is designed to query for full dates,
+9 ;so when the search result exceeds 200 appointments,
+10 ;the display will end with the last appointment of the last day before the maximum was reached.
CLINPTS2(Y,CLIN,ORBDATE,OREDATE) ; WRAPPER FUNCTION FOR USE BY RPC CALL ORQPT CLINIC PATIENTS
+1 NEW MAXAPPTS,APPTBGN,APPTEND,NUMAPPTS
+2 ; if we only want one day, don't limit answer.
SET MAXAPPTS=200
IF ORBDATE=OREDATE
SET MAXAPPTS=0
+3 DO CLINPTS(.Y,CLIN,ORBDATE,OREDATE,MAXAPPTS,.APPTBGN,.APPTEND)
+4 SET NUMAPPTS=$ORDER(Y(""),-1)
+5 IF MAXAPPTS
IF NUMAPPTS'<MAXAPPTS
Begin DoDot:1
+6 NEW ORI
+7 SET ORI=0
SET APPTEND=$PIECE(APPTEND,".")
+8 ;erase last day's appts since we assume it to be partial
FOR
SET ORI=$ORDER(Y(ORI))
if 'ORI
QUIT
Begin DoDot:2
+9 ;erase an appointment
IF APPTEND<$PIECE(Y(ORI),U,4)
KILL Y(ORI)
SET NUMAPPTS=NUMAPPTS-1
End DoDot:2
+10 SET Y(MAXAPPTS+1)="^ *** UNABLE TO SHOW ALL APPOINTMENTS ***"
+11 SET Y(MAXAPPTS+2)="^ Showing the first "_NUMAPPTS_" appointments from "_$$FMTE^XLFDT(APPTBGN,"D")_" to "_$$FMTE^XLFDT(APPTEND-1,"D")
+12 ;add blank line
SET Y(MAXAPPTS+3)="^"_$CHAR(160)_" Modify the appointment list date range to start on "_$$FMTE^XLFDT(APPTEND,"D")_" to see additional appointments."
+13 ;add blank line
SET Y(MAXAPPTS+4)="^"_$CHAR(160)_$CHAR(160)
End DoDot:1
+14 ;
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.
+2 IF +$GET(CLIN)<1
SET Y(1)="^No clinic identified"
QUIT
+3 IF $$ACTLOC^ORWU(CLIN)'=1
SET Y(1)="^Clinic is inactive or Occasion Of Service"
QUIT
+4 NEW ORSRV,ORRESULT,ORERR,ORI,ORPT,ORPTSTAT,ORAPPT,ORCLIN,SDARRAY,NODE
+5 IF $LENGTH($GET(MAXAPPTS))=0
SET MAXAPPTS=200
+6 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+7 IF ORBDATE=""
SET ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
+8 IF OREDATE=""
SET OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
+9 ;
+10 ; Convert ORBDATE, OREDATE to FM Date/Time:
+11 DO DT^DILF("T",ORBDATE,.ORBDATE,"","")
+12 DO DT^DILF("T",OREDATE,.OREDATE,"","")
+13 IF (ORBDATE=-1)!(OREDATE=-1)
SET Y(1)="^Error in date range."
QUIT
+14 ; Add 1/2 day to end date.
SET OREDATE=$PIECE(OREDATE,".")_.5
+15 ;
+16 ; *320 - use dbia 4433 instead of 3869.
+17 ;
+18 ;; IA# 3869:
+19 ;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house before starting.
+20 ;S ORRESULT=""
+21 ;S ORCLIN=+CLIN,ORFLDS="1;3;4;12",ORASTAT="R;NT",ORSTART=ORBDATE,OREND=OREDATE,ORSTAT="" ; Assign parameters.
+22 ;; ORFLDS: 1;3;4;12 = ApptDateTime;ApptStatus;IEN^PtName;PtStatus.
+23 ;D GETPLIST^SDAMA202(ORCLIN,ORFLDS,ORASTAT,ORSTART,OREND,.ORRESULT,ORSTAT) ; DBIA 3869.
+24 ;;
+25 ;; Deal with server errors:
+26 ;S ORERR=$$CLINERR^ORQRY01
+27 ;I $L(ORERR) S Y(1)=U_ORERR Q
+28 ;;
+29 ;; Reassign ^TMP array to local array:
+30 ;S (ORPT,ORI)=0,ORMAX=MAXAPPTS
+31 ;I ORRESULT'>0 S Y(1)="^No appointments." Q
+32 ;F S ORPT=$O(^TMP($J,"SDAMA202","GETPLIST",ORPT)) Q:ORPT=""!(ORI>ORMAX) D ;DBIA 3869
+33 ;.S ORI=ORI+1
+34 ;.S Y(ORI)=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,4)) ; IEN^Name.
+35 ;.S Y(ORI)=Y(ORI)_U_ORCLIN ; ^Clinic IEN.
+36 ;.S Y(ORI)=Y(ORI)_U_$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,1)) ; App't.
+37 ;.S ORPTSTAT=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,12)) ; Pt Status.
+38 ;.S ORPTSTAT=$S(ORPTSTAT="I":"IPT",ORPTSTAT="O":"OPT",1:"")
+39 ;.S ORHOLD=$G(^TMP($J,"SDAMA202","GETPLIST",ORPT,3)) ; Appt Status.
+40 ;.I ORPTSTAT=""&(ORHOLD="NT") S ORPTSTAT="NT" ; "No Action Taken."
+41 ;.S Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT ; Pt I or O status (or "NT").
+42 ;;
+43 ;K ^TMP($J,"SDAMA202","GETPLIST") ; Clean house after finishing.
+44 ;
+45 ; Clean house before starting.
KILL ^TMP($JOB,"SDAMA301")
+46 SET ORRESULT=""
+47 SET ORCLIN=+CLIN
+48 SET SDARRAY(1)=ORBDATE_";"_OREDATE
+49 SET SDARRAY(2)=+CLIN
+50 SET SDARRAY(3)="R;I;NT"
+51 ;no clinic index
SET SDARRAY("SORT")="P"
+52 ;ApptStatus^IEN;PtName
SET SDARRAY("FLDS")="3;4"
+53 IF MAXAPPTS
SET SDARRAY("MAX")=MAXAPPTS
+54 ;
+55 ; DBIA 4433
SET ORRESULT=$$SDAPI^SDAMA301(.SDARRAY)
+56 ;
+57 ; Deal with server errors:
+58 IF ORRESULT<0
Begin DoDot:1
+59 SET ORERR=""
+60 NEW IDXERR
SET IDXERR=$ORDER(^TMP($JOB,"SDAMA301",""))
if IDXERR'>0
QUIT
+61 SET ORERR=^TMP($JOB,"SDAMA301",IDXERR)
End DoDot:1
SET Y(1)=U_ORERR
QUIT
+62 ;
+63 ; Reassign ^TMP array to local array:
+64 SET (ORPT,ORI)=0
+65 IF ORRESULT'>0
SET Y(1)="^No appointments."
QUIT
+66 FOR
SET ORPT=$ORDER(^TMP($JOB,"SDAMA301",ORPT))
if ORPT=""
QUIT
Begin DoDot:1
+67 SET ORAPPT=""
+68 FOR
SET ORAPPT=$ORDER(^TMP($JOB,"SDAMA301",ORPT,ORAPPT))
if ORAPPT=""
QUIT
Begin DoDot:2
+69 SET ORI=ORI+1
+70 SET NODE=^TMP($JOB,"SDAMA301",ORPT,ORAPPT)
+71 ; IEN^Name.
SET Y(ORI)=$TRANSLATE($PIECE(NODE,U,4),";","^")
+72 ; ^Clinic IEN.
SET Y(ORI)=Y(ORI)_U_ORCLIN
+73 ; App't.
SET Y(ORI)=Y(ORI)_U_ORAPPT
+74 IF $LENGTH($GET(APPTEND))=0
SET APPTEND=ORAPPT
SET APPTBGN=ORAPPT
+75 IF ORAPPT>APPTEND
SET APPTEND=ORAPPT
+76 IF ORAPPT<APPTBGN
SET APPTBGN=ORAPPT
+77 ;appt status, will be transformed to pt status.
SET ORPTSTAT=$PIECE($PIECE(NODE,U,3),";",1)
+78 ; Pt Status.
SET ORPTSTAT=$SELECT(ORPTSTAT="I":"IPT",ORPTSTAT="R":"OPT",ORPTSTAT="NT":"OPT",1:"")
+79 ; Pt I or O status (or "NT").
SET Y(ORI)=Y(ORI)_U_U_U_U_U_ORPTSTAT
End DoDot:2
End DoDot:1
+80 ; Clean house after finishing.
KILL ^TMP($JOB,"SDAMA301")
+81 ;
+82 QUIT
+83 ;
CDATRANG(ORY) ; return default start and stop dates for clinics in form start^stop
+1 NEW ORBDATE,OREDATE,ORSRV
+2 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+3 SET ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
+4 SET OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
+5 SET ORBDATE=$SELECT($LENGTH($GET(ORBDATE)):ORBDATE,1:"")
SET OREDATE=$SELECT($LENGTH($GET(OREDATE)):OREDATE,1:"")
+6 SET ORY=$$UP^XLFSTR(ORBDATE)_"^"_$$UP^XLFSTR(OREDATE)
+7 QUIT
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
+2 IF +$GET(CLIN)>0
IF $$ACTLOC^ORWU(CLIN)'=1
SET Y(1)="^Clinic is inactive or Occasion Of Service"
QUIT
+3 ;IA 10061
NEW ERR,ERRMSG,VASD,NUM,CNT,INVDT,INT,EXT,ORSRV,VAERR
KILL ^UTILITY("VASD",$JOB)
SET NUM=0
SET CNT=1
+4 ;get user's service and set up entities:
IF (ORBDATE="")!(OREDATE="")
Begin DoDot:1
+5 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
End DoDot:1
+6 IF ORBDATE=""
Begin DoDot:1
+7 IF '$LENGTH(CLIN)
SET ORBDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
+8 ;default start date across all clinics is today
if ORBDATE=""
SET ORBDATE="T"
End DoDot:1
+9 IF OREDATE=""
Begin DoDot:1
+10 IF '$LENGTH(CLIN)
SET OREDATE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
+11 ;default end date across all clinics is today
if OREDATE=""
SET OREDATE="T"
End DoDot:1
+12 ;CONVERT ORBDATE AND OREDATE INTO FILEMAN DATE/TIME
+13 DO DT^DILF("T",ORBDATE,.ORBDATE,"","")
+14 DO DT^DILF("T",OREDATE,.OREDATE,"","")
+15 IF (ORBDATE=-1)!(OREDATE=-1)
SET Y(1)="^Error in date range."
QUIT
+16 SET VASD("F")=ORBDATE
+17 ;ADD 1/2 DAY TO END DATE
SET VASD("T")=$PIECE(OREDATE,".")_.5
+18 IF $LENGTH($GET(CLIN))
SET VASD("C",CLIN)=""
+19 DO SDA^ORQRY01(.ERR,.ERRMSG)
+20 IF ERR
KILL ^UTILITY("VASD",$JOB)
SET Y(1)=ERRMSG
QUIT
+21 FOR
SET NUM=$ORDER(^UTILITY("VASD",$JOB,NUM))
if 'NUM
QUIT
Begin DoDot:1
+22 SET INT=^UTILITY("VASD",$JOB,NUM,"I")
SET INVDT=9999999-$PIECE(INT,U)
+23 SET EXT=^UTILITY("VASD",$JOB,NUM,"E")
+24 SET Y(CNT)=$PIECE(INT,U)_U_$PIECE(EXT,U,2)_U_$PIECE(EXT,U,3)_U_$PIECE(EXT,U,4)_U_INVDT
+25 SET CNT=CNT+1
End DoDot:1
+26 if +$GET(Y(1))<1
SET Y(1)="^No appointments."
+27 KILL ^UTILITY("VASD",$JOB)
+28 QUIT
PROV(Y) ; RETURN LIST OF PROVIDERS
+1 NEW I,IEN,NAME,TDATE
+2 SET I=1
SET NAME=""
+3 FOR
SET NAME=$ORDER(^VA(200,"B",NAME))
if NAME=""
QUIT
SET IEN=0
SET IEN=$ORDER(^(NAME,IEN))
Begin DoDot:1
+4 if $EXTRACT(NAME)="*"
QUIT
+5 IF $DATA(^XUSEC("PROVIDER",IEN))
IF $$ACTIVE^XUSER(IEN)
SET Y(I)=IEN_"^"_NAME
SET I=I+1
End DoDot:1
+6 QUIT
PROVPTS(Y,PROV) ; RETURN LIST OF PATIENTS LINKED TO A PRIMARY PROVIDER
+1 IF +$GET(PROV)<1
SET Y(1)="^No provider identified"
QUIT
+2 NEW ORI,DFN
+3 SET ORI=1
SET DFN=0
+4 FOR
SET DFN=$ORDER(^DPT("APR",PROV,DFN))
if DFN'>0
QUIT
SET Y(ORI)=+DFN_"^"_$PIECE(^DPT(+DFN,0),"^")
SET ORI=ORI+1
+5 if +$GET(Y(1))<1
SET Y(1)="^No patients found."
+6 QUIT
SPEC(Y) ; RETURN LIST OF TREATING SPECIALTIES
+1 NEW I,NAME,IEN
+2 SET I=1
SET NAME=""
+3 ;access to DIC(45.7 global granted under DBIA #519:
+4 FOR
SET NAME=$ORDER(^DIC(45.7,"B",NAME))
if NAME=""
QUIT
SET IEN=0
SET IEN=$ORDER(^(NAME,IEN))
IF $$ACTIVE^DGACT(45.7,IEN)
SET Y(I)=IEN_"^"_NAME
SET I=I+1
+5 QUIT
SPECPTS(Y,SPEC) ; RETURN LIST OF PATIENTS LINKED TO A TREATING SPECIALTY
+1 IF +$GET(SPEC)<1
SET Y(1)="^No specialty identified"
QUIT
+2 NEW ORI,DFN
+3 SET ORI=1
SET DFN=0
+4 FOR
SET DFN=$ORDER(^DPT("ATR",SPEC,DFN))
if DFN'>0
QUIT
SET Y(ORI)=+DFN_"^"_$PIECE(^DPT(+DFN,0),"^")
SET ORI=ORI+1
+5 if +$GET(Y(1))<1
SET Y(1)="^No patients found."
+6 QUIT
WARD(Y) ; RETURN LIST OF ACTIVE WARDS
+1 NEW I,IEN,NAME,D0
+2 SET I=1
SET NAME=""
+3 ;access to DIC(42 global granted under DBIA #36:
+4 FOR
SET NAME=$ORDER(^DIC(42,"B",NAME))
if NAME=""
QUIT
SET IEN=$ORDER(^(NAME,0))
Begin DoDot:1
+5 SET D0=IEN
DO WIN^DGPMDDCF
+6 IF X=0
SET Y(I)=IEN_"^"_NAME
SET I=I+1
End DoDot:1
+7 QUIT
WARDPTS(Y,WARD) ; RETURN LIST OF PATIENTS IN A WARD
+1 ; SLC/PKS - Modifications for Room/Bed data on 1/19/2001.
+2 IF +$GET(WARD)<1
SET Y(1)="^No ward identified"
QUIT
+3 NEW ORI,DFN,RBDAT
+4 SET ORI=1
SET DFN=0
+5 ; Access to DIC(42 global granted under DBIA #36:
+6 ;GET WARD NAME FOR "CN" LOOKUP
SET WARD=$PIECE(^DIC(42,WARD,0),"^")
+7 ; Next section modified 1/19/2001 by PKS:
+8 FOR
Begin DoDot:1
+9 SET DFN=$ORDER(^DPT("CN",WARD,DFN))
if DFN'>0
QUIT
+10 SET Y(ORI)=+DFN_"^"_$PIECE(^DPT(+DFN,0),"^")
+11 SET RBDAT=""
+12 ; Add patient room/bed information where data exists:
+13 SET RBDAT=$PIECE($GET(^DPT(+DFN,.101)),U)
+14 ; Any R/B data?
IF RBDAT'=""
Begin DoDot:2
+15 ; Add if < 4 chars.
IF $LENGTH(RBDAT)<4
SET RBDAT=RBDAT_" "
+16 ; Get first 4 only.
SET RBDAT=$EXTRACT(RBDAT,1,4)
End DoDot:2
+17 ; Add R/B to string
SET Y(ORI)=Y(ORI)_U_RBDAT
+18 ; Increment counter.
SET ORI=ORI+1
End DoDot:1
if DFN'>0
QUIT
+19 ;
+20 if +$GET(Y(1))<1
SET Y(1)="^No patients found."
+21 QUIT
NLIST(ORQY) ; return a null list
+1 SET ORQY(1)=""
+2 QUIT
