ORQQVS ; slc/CLA,STAFF - Functions which return patient visits ;3/16/05 10:27
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,195,215,271**;Dec 17, 1997;Build 2
;
; DBIA 2812 NOTES^TIUSRVLV ^TMP("TIULIST",$J)
; DBIA 2944 TGET^TIUSRVR1 ^TMP("TIUVIEW",$J)
; DBIA 1905 SELECTED^VSIT ^TMP("VSIT",$J)
;
LIST(ORY,PT,ORSDT,OREDT,LOC) ; return visits for a patient between start & end dates for a location, if no location return all visits
N VIEN,NUM,CNT,INVDT,ORSRV,CNTLIMIT,ORX
S CNTLIMIT=100 ;limit visits to 100 most recent Visit entries
S VIEN="A",NUM=0,CNT=1
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
I ORSDT="" D
.I '$L(LOC) S ORSDT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
.I ORSDT="" S ORSDT="T-730" ;default start date is two years ago
I OREDT="" D
.I '$L(LOC) S OREDT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
.I OREDT="" S OREDT="T" ;default end date is today
;CONVERT ORSDT AND OREDT INTO FILEMAN DATE/TIME
D DT^DILF("T",ORSDT,.ORSDT,"","")
D DT^DILF("T",OREDT,.OREDT,"","")
I (ORSDT=-1)!(OREDT=-1) S ORY(1)="^Error in date range." Q
K ^TMP("VSIT",$J) ;DBIA 1905
D SELECTED^VSIT(PT,ORSDT,OREDT,LOC,"") ;DBIA 1905
F S VIEN=$O(^TMP("VSIT",$J,VIEN),-1) Q:VIEN=""!(CNT>CNTLIMIT) D
.F S NUM=$O(^TMP("VSIT",$J,VIEN,NUM)) Q:NUM="" D
..S ORX=^TMP("VSIT",$J,VIEN,NUM),INVDT=9999999-$P(ORX,U)
..I $$ACTLOC^ORWU(+$P(ORX,U,2))=1 D
...S ORY(CNT)=VIEN_U_ORX_U_INVDT,CNT=CNT+1
K ^TMP("VSIT",$J)
Q
VSITAPPT(ORVY,PT,SDT,EDT,DUMMY) ; return past visits and future appointments for a patient between start and end dates
N NDT,CNT,I,TS,ORVSITY K ORVY D NOW^%DTC S NDT=+%,CNT=1 K %
D PTAPPTS^ORQPTQ2(.ORYA,PT,NDT,EDT,"") ;get future appointments
S I=0 F S I=$O(ORYA(I)) Q:I<1 I ORYA(I)'["No appts",+ORYA(I) D
.S ORVY(CNT)=$P(ORYA(I),U)_";s"_U_$P(ORYA(I),U,2)_U_"sched:"_U_$P(ORYA(I),U)
.S ORVY(CNT)=ORVY(CNT)_U_$P(ORYA(I),U,5),CNT=CNT+1
D LIST(.YV,PT,SDT,NDT,"") ;get past visits
S I=0 F S I=$O(YV(I)) Q:I<1 D
.S ORVY(CNT)=$P(YV(I),U)_";v"_U_$P($P(YV(I),U,3),";",2)
.I $P(YV(I),U,4)="H" D
..S ORVY(CNT)=$P(YV(I),U)_";a"_U_"Inpatient Stay"_U_"admitted:"
.I $P(YV(I),U,4)'="H" S ORVY(CNT)=ORVY(CNT)_U_"visited:"
.S ORVY(CNT)=ORVY(CNT)_U_$P(YV(I),U,2)_U_$P(YV(I),U,8),CNT=CNT+1
S:+$G(ORVY(1))<1 ORVY(1)="^No appts or visits found."
S TSTDT=DT_".2359"
D DT^DILF("T",EDT,.EDT,"","")
I (EDT>TSTDT) D
. I '$L($P($G(ORYA(1)),U)),$L($P($G(ORYA(1)),U,2)),'$L($O(ORYA(1))) D
. . K ORVY S ORVY(1)=ORYA(1)
K ORYA,YV
Q
DETNOTE(ORVY,ORPT,ORVIEN) ;return progress notes for a patient's visit
N ORTY,ORY,TDT,ORVI
S TDT=0
K ^TMP("TIULIST",$J) ;DBIA 2812
D NOTES^TIUSRVLV(.ORY,ORVIEN) ;DBIA 2812
I '+$O(^TMP("TIULIST",$J,0)) D Q
. S ORVY(1)="No Progress Notes for this visit."
S ORVI=1
F S TDT=$O(^TMP("TIULIST",$J,TDT)) Q:+TDT'>0 D
. N SEQ,TIEN S SEQ=0
. F S SEQ=$O(^TMP("TIULIST",$J,TDT,SEQ)) Q:+SEQ'>0 D
. . N TSEQ K ^TMP("TIUVIEW",$J) ;DBIA 2944
. . S TIEN=$P(^TMP("TIULIST",$J,TDT,SEQ),U)
. . D TGET^TIUSRVR1(.ORTY,TIEN) ;DBIA 2944
. . S TSEQ=0
. . F S TSEQ=$O(@ORTY@(TSEQ)) Q:TSEQ="" D
. . . S ORVY(ORVI)=@ORTY@(TSEQ),ORVI=ORVI+1
. . S ORVY(ORVI)=" ",ORVI=ORVI+1
. . S ORVY(ORVI)=" ",ORVI=ORVI+1
K ^TMP("TIULIST",$J)
Q
DETSUM(ORVY,ORPT,ORVIEN) ;return discharge summary for a patient's visit
N CR,ORTY,ORY,TDT
S TDT=0
K ^TMP("TIULIST",$J)
D SUMMARY^TIUSRVLV(.ORY,ORVIEN)
I '+$O(^TMP("TIULIST",$J,0)) D Q
. S ORVY(1)="No Discharge Summary found for this stay."
F S TDT=$O(^TMP("TIULIST",$J,TDT)) Q:+TDT'>0 D
. N SEQ,TIEN S SEQ=0
. F S SEQ=$O(^TMP("TIULIST",$J,TDT,SEQ)) Q:+SEQ'>0 D
. . N TSEQ,ORVI K ^TMP("TIUVIEW",$J)
. . S TIEN=$P(^TMP("TIULIST",$J,TDT,SEQ),U)
. . D TGET^TIUSRVR1(.ORTY,TIEN)
. . S TSEQ=0,ORVI=1
. . F S TSEQ=$O(@ORTY@(TSEQ)) Q:TSEQ="" D
. . . S ORVY(ORVI)=@ORTY@(TSEQ),ORVI=ORVI+1
. . S ORVY(ORVI)=" ",ORVI=ORVI+1
. . S ORVY(ORVI)=" ",ORVI=ORVI+1
K ^TMP("TIULIST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQVS 4102 printed Oct 16, 2024@18:34:25 Page 2
ORQQVS ; slc/CLA,STAFF - Functions which return patient visits ;3/16/05 10:27
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,195,215,271**;Dec 17, 1997;Build 2
+2 ;
+3 ; DBIA 2812 NOTES^TIUSRVLV ^TMP("TIULIST",$J)
+4 ; DBIA 2944 TGET^TIUSRVR1 ^TMP("TIUVIEW",$J)
+5 ; DBIA 1905 SELECTED^VSIT ^TMP("VSIT",$J)
+6 ;
LIST(ORY,PT,ORSDT,OREDT,LOC) ; return visits for a patient between start & end dates for a location, if no location return all visits
+1 NEW VIEN,NUM,CNT,INVDT,ORSRV,CNTLIMIT,ORX
+2 ;limit visits to 100 most recent Visit entries
SET CNTLIMIT=100
+3 SET VIEN="A"
SET NUM=0
SET CNT=1
+4 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+5 IF ORSDT=""
Begin DoDot:1
+6 IF '$LENGTH(LOC)
SET ORSDT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT START",1,"E"))
+7 ;default start date is two years ago
IF ORSDT=""
SET ORSDT="T-730"
End DoDot:1
+8 IF OREDT=""
Begin DoDot:1
+9 IF '$LENGTH(LOC)
SET OREDT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQEAPT ENC APPT STOP",1,"E"))
+10 ;default end date is today
IF OREDT=""
SET OREDT="T"
End DoDot:1
+11 ;CONVERT ORSDT AND OREDT INTO FILEMAN DATE/TIME
+12 DO DT^DILF("T",ORSDT,.ORSDT,"","")
+13 DO DT^DILF("T",OREDT,.OREDT,"","")
+14 IF (ORSDT=-1)!(OREDT=-1)
SET ORY(1)="^Error in date range."
QUIT
+15 ;DBIA 1905
KILL ^TMP("VSIT",$JOB)
+16 ;DBIA 1905
DO SELECTED^VSIT(PT,ORSDT,OREDT,LOC,"")
+17 FOR
SET VIEN=$ORDER(^TMP("VSIT",$JOB,VIEN),-1)
if VIEN=""!(CNT>CNTLIMIT)
QUIT
Begin DoDot:1
+18 FOR
SET NUM=$ORDER(^TMP("VSIT",$JOB,VIEN,NUM))
if NUM=""
QUIT
Begin DoDot:2
+19 SET ORX=^TMP("VSIT",$JOB,VIEN,NUM)
SET INVDT=9999999-$PIECE(ORX,U)
+20 IF $$ACTLOC^ORWU(+$PIECE(ORX,U,2))=1
Begin DoDot:3
+21 SET ORY(CNT)=VIEN_U_ORX_U_INVDT
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+22 KILL ^TMP("VSIT",$JOB)
+23 QUIT
VSITAPPT(ORVY,PT,SDT,EDT,DUMMY) ; return past visits and future appointments for a patient between start and end dates
+1 NEW NDT,CNT,I,TS,ORVSITY
KILL ORVY
DO NOW^%DTC
SET NDT=+%
SET CNT=1
KILL %
+2 ;get future appointments
DO PTAPPTS^ORQPTQ2(.ORYA,PT,NDT,EDT,"")
+3 SET I=0
FOR
SET I=$ORDER(ORYA(I))
if I<1
QUIT
IF ORYA(I)'["No appts"
IF +ORYA(I)
Begin DoDot:1
+4 SET ORVY(CNT)=$PIECE(ORYA(I),U)_";s"_U_$PIECE(ORYA(I),U,2)_U_"sched:"_U_$PIECE(ORYA(I),U)
+5 SET ORVY(CNT)=ORVY(CNT)_U_$PIECE(ORYA(I),U,5)
SET CNT=CNT+1
End DoDot:1
+6 ;get past visits
DO LIST(.YV,PT,SDT,NDT,"")
+7 SET I=0
FOR
SET I=$ORDER(YV(I))
if I<1
QUIT
Begin DoDot:1
+8 SET ORVY(CNT)=$PIECE(YV(I),U)_";v"_U_$PIECE($PIECE(YV(I),U,3),";",2)
+9 IF $PIECE(YV(I),U,4)="H"
Begin DoDot:2
+10 SET ORVY(CNT)=$PIECE(YV(I),U)_";a"_U_"Inpatient Stay"_U_"admitted:"
End DoDot:2
+11 IF $PIECE(YV(I),U,4)'="H"
SET ORVY(CNT)=ORVY(CNT)_U_"visited:"
+12 SET ORVY(CNT)=ORVY(CNT)_U_$PIECE(YV(I),U,2)_U_$PIECE(YV(I),U,8)
SET CNT=CNT+1
End DoDot:1
+13 if +$GET(ORVY(1))<1
SET ORVY(1)="^No appts or visits found."
+14 SET TSTDT=DT_".2359"
+15 DO DT^DILF("T",EDT,.EDT,"","")
+16 IF (EDT>TSTDT)
Begin DoDot:1
+17 IF '$LENGTH($PIECE($GET(ORYA(1)),U))
IF $LENGTH($PIECE($GET(ORYA(1)),U,2))
IF '$LENGTH($ORDER(ORYA(1)))
Begin DoDot:2
+18 KILL ORVY
SET ORVY(1)=ORYA(1)
End DoDot:2
End DoDot:1
+19 KILL ORYA,YV
+20 QUIT
DETNOTE(ORVY,ORPT,ORVIEN) ;return progress notes for a patient's visit
+1 NEW ORTY,ORY,TDT,ORVI
+2 SET TDT=0
+3 ;DBIA 2812
KILL ^TMP("TIULIST",$JOB)
+4 ;DBIA 2812
DO NOTES^TIUSRVLV(.ORY,ORVIEN)
+5 IF '+$ORDER(^TMP("TIULIST",$JOB,0))
Begin DoDot:1
+6 SET ORVY(1)="No Progress Notes for this visit."
End DoDot:1
QUIT
+7 SET ORVI=1
+8 FOR
SET TDT=$ORDER(^TMP("TIULIST",$JOB,TDT))
if +TDT'>0
QUIT
Begin DoDot:1
+9 NEW SEQ,TIEN
SET SEQ=0
+10 FOR
SET SEQ=$ORDER(^TMP("TIULIST",$JOB,TDT,SEQ))
if +SEQ'>0
QUIT
Begin DoDot:2
+11 ;DBIA 2944
NEW TSEQ
KILL ^TMP("TIUVIEW",$JOB)
+12 SET TIEN=$PIECE(^TMP("TIULIST",$JOB,TDT,SEQ),U)
+13 ;DBIA 2944
DO TGET^TIUSRVR1(.ORTY,TIEN)
+14 SET TSEQ=0
+15 FOR
SET TSEQ=$ORDER(@ORTY@(TSEQ))
if TSEQ=""
QUIT
Begin DoDot:3
+16 SET ORVY(ORVI)=@ORTY@(TSEQ)
SET ORVI=ORVI+1
End DoDot:3
+17 SET ORVY(ORVI)=" "
SET ORVI=ORVI+1
+18 SET ORVY(ORVI)=" "
SET ORVI=ORVI+1
End DoDot:2
End DoDot:1
+19 KILL ^TMP("TIULIST",$JOB)
+20 QUIT
DETSUM(ORVY,ORPT,ORVIEN) ;return discharge summary for a patient's visit
+1 NEW CR,ORTY,ORY,TDT
+2 SET TDT=0
+3 KILL ^TMP("TIULIST",$JOB)
+4 DO SUMMARY^TIUSRVLV(.ORY,ORVIEN)
+5 IF '+$ORDER(^TMP("TIULIST",$JOB,0))
Begin DoDot:1
+6 SET ORVY(1)="No Discharge Summary found for this stay."
End DoDot:1
QUIT
+7 FOR
SET TDT=$ORDER(^TMP("TIULIST",$JOB,TDT))
if +TDT'>0
QUIT
Begin DoDot:1
+8 NEW SEQ,TIEN
SET SEQ=0
+9 FOR
SET SEQ=$ORDER(^TMP("TIULIST",$JOB,TDT,SEQ))
if +SEQ'>0
QUIT
Begin DoDot:2
+10 NEW TSEQ,ORVI
KILL ^TMP("TIUVIEW",$JOB)
+11 SET TIEN=$PIECE(^TMP("TIULIST",$JOB,TDT,SEQ),U)
+12 DO TGET^TIUSRVR1(.ORTY,TIEN)
+13 SET TSEQ=0
SET ORVI=1
+14 FOR
SET TSEQ=$ORDER(@ORTY@(TSEQ))
if TSEQ=""
QUIT
Begin DoDot:3
+15 SET ORVY(ORVI)=@ORTY@(TSEQ)
SET ORVI=ORVI+1
End DoDot:3
+16 SET ORVY(ORVI)=" "
SET ORVI=ORVI+1
+17 SET ORVY(ORVI)=" "
SET ORVI=ORVI+1
End DoDot:2
End DoDot:1
+18 KILL ^TMP("TIULIST",$JOB)
+19 QUIT
