BDGSVL ; IHS/ANMC/LJF - SCHED VISITS LIST ;
;;5.3;PIMS;;APR 26, 2002
;
NEW BDGBD,BDGED,BDGVT,BDGRT,BDGS1,BDGS2,BDGA,X,I,BDGEX
;
; aks user for date range
S BDGBD=$$READ^BDGF("DO^::EX","Select Earliest Date Expected")
Q:BDGBD<1
S BDGED=$$READ^BDGF("DO^::EX","Select Latest Date Expected")
Q:BDGED<1
;
; ask user for visit type
S BDGVT=$$READ^BDGF("SO^1:Admissions;2:Day Surgeries;3:Outpatient Visits;4:All Types","Select Visit Type for Report") Q:'BDGVT
S BDGVT=$S(BDGVT=1:"A",BDGVT=2:"D",BDGVT=3:"O",1:BDGVT)
;
S BDGEX=$$READ^BDGF("Y","Include No-Shows and Cancellations","NO")
Q:BDGEX=U
;
; set up main sort
K BDGA W !
I BDGVT="A" F I=1,2,4,5,6,7,8,9 D GETSORT(I) ;admissions
I BDGVT="D" F I=1,2,4,5,6,7,8 D GETSORT(I) ;day surgeries
I BDGVT="O" F I=1,2,3,4,5,6,8 D GETSORT(I) ;outpatient visits
I BDGVT=4 F I=1,2,4,5,6,8 D GETSORT(I) ;all
S I=0 F S I=$O(BDGA(I)) Q:'I S X=I W !,$J(I,2),". ",$P(BDGA(I),U,2)
S Y=$$READ^BDGF("N^1:"_X,"Sort Report By") Q:'Y
S BDGS1=BDGA(Y)
;
; set up subsort
K BDGA W !
I BDGVT="A" F I=1,2,4,5,6,7,8,9 D GETSORT(I) ;admissions
I BDGVT="D" F I=1,2,4,5,6,7,8 D GETSORT(I) ;day surgeries
I BDGVT="O" F I=1,2,3,4,5,6,8 D GETSORT(I) ;outpatient visits
I BDGVT=4 F I=1,2,4,5,6,8 D GETSORT(I) ;all
S I=0 F S I=$O(BDGA(I)) Q:'I S X=I W !,$J(I,2),". ",$P(BDGA(I),U,2)
S Y=$$READ^BDGF("N^1:"_X,"Within "_$P(BDGS1,U,2)_" Sort Report By")
Q:'Y S BDGS2=BDGA(Y)
;
; get report type
I $D(^XUSEC("DGZNOCLN",DUZ)) S BDGRT="B"
E S BDGRT=$$READ^BDGF("S^B:Brief;D:Detailed","Select Report Type","B")
Q:BDGRT=U Q:BDGRT=""
;
; call print device
I $$BROWSE^BDGF="B" D EN^BDGSVL1 Q
D ZIS^BDGF("QP","EN^BDGSVL1","SCHEDULED VISITS LIST","BDGBD;BDGED;BDGVT;BDGS1;BDGS2;BDGRT;BDGEX")
Q
;
;
GETSORT(X) ; build BDGA array for sort questions
; don't repeat sort item under subsort if already selected
I $D(BDGS1),$P(BDGS1,U)=$P($T(SORT+X),";;",3) Q
;
NEW Y S Y=$O(BDGA(99),-1)+1
S BDGA(Y)=$P($T(SORT+X),";;",3)_U_$P($T(SORT+X),";;",2)
Q
;
SORT ;;
;;Authorizing Provider;;.04;;
;;Case Manager;;.05;;
;;Clinic;;.11;;
;;Community;;.013;;
;;Date Expected;;.02;;
;;Patient Name;;.01;;
;;Service;;.08;.121;;
;;Visit Disposition;;.16;;
;;Ward;;.09;;
BDGSVL ; IHS/ANMC/LJF - SCHED VISITS LIST ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 NEW BDGBD,BDGED,BDGVT,BDGRT,BDGS1,BDGS2,BDGA,X,I,BDGEX
+4 ;
+5 ; aks user for date range
+6 SET BDGBD=$$READ^BDGF("DO^::EX","Select Earliest Date Expected")
+7 IF BDGBD<1
QUIT
+8 SET BDGED=$$READ^BDGF("DO^::EX","Select Latest Date Expected")
+9 IF BDGED<1
QUIT
+10 ;
+11 ; ask user for visit type
+12 SET BDGVT=$$READ^BDGF("SO^1:Admissions;2:Day Surgeries;3:Outpatient Visits;4:All Types","Select Visit Type for Report")
IF 'BDGVT
QUIT
+13 SET BDGVT=$SELECT(BDGVT=1:"A",BDGVT=2:"D",BDGVT=3:"O",1:BDGVT)
+14 ;
+15 SET BDGEX=$$READ^BDGF("Y","Include No-Shows and Cancellations","NO")
+16 IF BDGEX=U
QUIT
+17 ;
+18 ; set up main sort
+19 KILL BDGA
WRITE !
+20 ;admissions
IF BDGVT="A"
FOR I=1,2,4,5,6,7,8,9
DO GETSORT(I)
+21 ;day surgeries
IF BDGVT="D"
FOR I=1,2,4,5,6,7,8
DO GETSORT(I)
+22 ;outpatient visits
IF BDGVT="O"
FOR I=1,2,3,4,5,6,8
DO GETSORT(I)
+23 ;all
IF BDGVT=4
FOR I=1,2,4,5,6,8
DO GETSORT(I)
+24 SET I=0
FOR
SET I=$ORDER(BDGA(I))
IF 'I
QUIT
SET X=I
WRITE !,$JUSTIFY(I,2),". ",$PIECE(BDGA(I),U,2)
+25 SET Y=$$READ^BDGF("N^1:"_X,"Sort Report By")
IF 'Y
QUIT
+26 SET BDGS1=BDGA(Y)
+27 ;
+28 ; set up subsort
+29 KILL BDGA
WRITE !
+30 ;admissions
IF BDGVT="A"
FOR I=1,2,4,5,6,7,8,9
DO GETSORT(I)
+31 ;day surgeries
IF BDGVT="D"
FOR I=1,2,4,5,6,7,8
DO GETSORT(I)
+32 ;outpatient visits
IF BDGVT="O"
FOR I=1,2,3,4,5,6,8
DO GETSORT(I)
+33 ;all
IF BDGVT=4
FOR I=1,2,4,5,6,8
DO GETSORT(I)
+34 SET I=0
FOR
SET I=$ORDER(BDGA(I))
IF 'I
QUIT
SET X=I
WRITE !,$JUSTIFY(I,2),". ",$PIECE(BDGA(I),U,2)
+35 SET Y=$$READ^BDGF("N^1:"_X,"Within "_$PIECE(BDGS1,U,2)_" Sort Report By")
+36 IF 'Y
QUIT
SET BDGS2=BDGA(Y)
+37 ;
+38 ; get report type
+39 IF $DATA(^XUSEC("DGZNOCLN",DUZ))
SET BDGRT="B"
+40 IF '$TEST
SET BDGRT=$$READ^BDGF("S^B:Brief;D:Detailed","Select Report Type","B")
+41 IF BDGRT=U
QUIT
IF BDGRT=""
QUIT
+42 ;
+43 ; call print device
+44 IF $$BROWSE^BDGF="B"
DO EN^BDGSVL1
QUIT
+45 DO ZIS^BDGF("QP","EN^BDGSVL1","SCHEDULED VISITS LIST","BDGBD;BDGED;BDGVT;BDGS1;BDGS2;BDGRT;BDGEX")
+46 QUIT
+47 ;
+48 ;
GETSORT(X) ; build BDGA array for sort questions
+1 ; don't repeat sort item under subsort if already selected
+2 IF $DATA(BDGS1)
IF $PIECE(BDGS1,U)=$PIECE($TEXT(SORT+X),";;",3)
QUIT
+3 ;
+4 NEW Y
SET Y=$ORDER(BDGA(99),-1)+1
+5 SET BDGA(Y)=$PIECE($TEXT(SORT+X),";;",3)_U_$PIECE($TEXT(SORT+X),";;",2)
+6 QUIT
+7 ;
SORT ;;
+1 ;;Authorizing Provider;;.04;;
+2 ;;Case Manager;;.05;;
+3 ;;Clinic;;.11;;
+4 ;;Community;;.013;;
+5 ;;Date Expected;;.02;;
+6 ;;Patient Name;;.01;;
+7 ;;Service;;.08;.121;;
+8 ;;Visit Disposition;;.16;;
+9 ;;Ward;;.09;;