- 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 Jan 18, 2025@03:34:36 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