BSDWL ; IHS/ANMC/LJF - WAITING LIST REPORTS ; [ 01/09/2003 1:31 PM ]
;;5.3;PIMS;**1004,1007**;MAY 28, 2004
;IHS/OIT/LJF 07/21/2005 PATCH 1004 add choice to print each sort on separate paper
; 07/22/2005 PATCH 1004 fixed so Include Removed? is pre-answered if using Date Removed
; 08/31/2005 PATCH 1004 check for patient trying to quit before asking paper question
;cmi/anch/maw 01/15/2007 PATCH 1007 includes print by for wait list report
;
ASK ; ask user questions
NEW BSDWLN,BSDA,BSDATE,BSDSRT,I,BSDBD,BSDED,BSDREM
S BSDWLN=+$$READ^BDGF("PO^9009017.1:EMQ","Select Clinic or Ward")
Q:BSDWLN<1
;
W !! F I=1:1:3 S BSDA(I)=$J(I,4)_") "_$P($T(DATE+I),";;",2)
S BSDATE=$$READ^BDGF("NO^1:3","Select Date Range Type","","","",.BSDA)
I (BSDATE=U)!(BSDATE="") Q
S BSDATE=$P($T(DATE+BSDATE),";;",2,3),BSDATE=$P(BSDATE,";;",2)_U_$P(BSDATE,";;")
;
W ! S BSDBD=$$READ^BDGF("DO^::EX","Select Beginning Date") I BSDBD<1 Q
S BSDED=$$READ^BDGF("DO^::EX","Select Ending Date") I BSDED<1 Q
;
;I BSDATE=".07" S BSDREM=1 ;include removed entries
I $P(BSDATE,U)=".07" S BSDREM=1 ;include removed entries ;IHS/OIT/LJF 7/22/2005 PATCH 1004
E W ! S BSDREM=$$READ^BDGF("Y","Include Entries Already Removed from List","NO")
I BSDREM=U Q
;
W !! K BSDA F I=1:1:5 S BSDA(I)=$J(I,4)_") "_$P($T(SORT+I),";;",2)
S BSDSRT=$$READ^BDGF("NO^1:5","Select Sort","","","",.BSDA)
I (BSDSRT=U)!(BSDSRT="") Q
I BSDSRT=1 S BSDSRT=BSDSRT_U_BSDATE ;sorting by date
E S BSDSRT=BSDSRT_U_$P($T(SORT+BSDSRT),";;",3) ;sort field
;
;cmi/anch/maw added patch 1007 item 1007.28
S BSDPRTYN=$$READ^BDGF("Y","Select item to Print By","NO")
K BSDSEL
I $G(BSDPRTYN) D
. W !! K BSDA F I=1:1:5 S BSDA(I)=$J(I,4)_") "_$P($T(SORT+I),";;",2)
. S BSDPRTB=$$READ^BDGF("NO^1:5","Print By","","","",.BSDA)
. I (BSDPRTB=U)!(BSDPRTB="") Q
. I BSDPRTB=1 S BSDPRTB=BSDPRTB_U_BSDATE ;printing by date
. I BSDPRTB'=1 D ;print field
.. I BSDPRTB=2 D PRI Q
.. I BSDPRTB=3 D PROV Q
.. I BSDPRTB=4 D REA Q
.. I BSDPRTB=5 D RES Q
I '$G(BSDSEL) K BSDPRTYN
;cmi/anch/maw end of mods
;
;IHS/OIT/LJF 8.31.2005 PATCH 1004 check for user ^ out too
;I $$BROWSE^BDGF="B" D EN^BSDWLL Q
S X=$$BROWSE^BDGF I X=U Q
I X="B" D EN^BSDWLL Q
;
;IHS/OIT/LJF 7/21/2005 PATCH 1004
NEW BSDPAG S BSDPAG=$$READ^BDGF("Y","Print each "_$P($T(SORT+BSDSRT),";;",4)_" on separate piece of paper","NO") Q:BSDPAG=U
;
D ZIS^BDGF("PQ","EN^BSDWLL","Waiting List Report","BSD*")
Q
;
PRI ;-- get priority
;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
S DIR(0)="S^"_$P(^DD(9009017.11,.02,0),U,3),DIR("A")="Select Priority: "
D ^DIR
Q:$D(DIRUT)
S BSDPRI(+Y)=""
S BSDSEL=1
N BSDAN
S BSDAN=$$READ^BDGF("Y","Select Another","NO")
I $G(BSDAN) G PRI
Q
;
PROV ;--get provider(s)
;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
S DIC(0)="AEMQZ",DIC=200,DIC("A")="Select Provider: "
D ^DIC
Q:'+$G(Y)
S BSDPROV(+Y)=""
S BSDSEL=1
N BSDAN
S BSDAN=$$READ^BDGF("Y","Select Another","NO")
I $G(BSDAN) G PROV
Q
;
REA ;-- get reason(s)
;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
S DIC(0)="AEMQZ",DIC=9009017.4,DIC("A")="Select Reason: "
D ^DIC
Q:'+$G(Y)
S BSDREA(+Y)=""
S BSDSEL=1
N BSDAN
S BSDAN=$$READ^BDGF("Y","Select Another","NO")
I $G(BSDAN) G REA
Q
;
RES ;-- get resolution(s)
;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
S DIC(0)="AEMQZ",DIC=9009017.4,DIC("A")="Select Resolution: "
D ^DIC
Q:'+$G(Y)
S BSDRES(+Y)=""
S BSDSEL=1
N BSDAN
S BSDAN=$$READ^BDGF("Y","Select Another","NO")
I $G(BSDAN) G RES
Q
;
DATE ;;
;;Date Added to List;;.03;;
;;Recall Date;;.05;;
;;Date Removed from List;;.07;;
;;
SORT ;;
;;By Dates Selected;;;;DATE
;;By Priority;;.02;;PRIORITY
;;By Provider;;.06;;PROVIDER
;;By Reason Added;;.09;;REASON
;;By Resolution;;.08;;RESOLUTION
BSDWL ; IHS/ANMC/LJF - WAITING LIST REPORTS ; [ 01/09/2003 1:31 PM ]
+1 ;;5.3;PIMS;**1004,1007**;MAY 28, 2004
+2 ;IHS/OIT/LJF 07/21/2005 PATCH 1004 add choice to print each sort on separate paper
+3 ; 07/22/2005 PATCH 1004 fixed so Include Removed? is pre-answered if using Date Removed
+4 ; 08/31/2005 PATCH 1004 check for patient trying to quit before asking paper question
+5 ;cmi/anch/maw 01/15/2007 PATCH 1007 includes print by for wait list report
+6 ;
ASK ; ask user questions
+1 NEW BSDWLN,BSDA,BSDATE,BSDSRT,I,BSDBD,BSDED,BSDREM
+2 SET BSDWLN=+$$READ^BDGF("PO^9009017.1:EMQ","Select Clinic or Ward")
+3 IF BSDWLN<1
QUIT
+4 ;
+5 WRITE !!
FOR I=1:1:3
SET BSDA(I)=$JUSTIFY(I,4)_") "_$PIECE($TEXT(DATE+I),";;",2)
+6 SET BSDATE=$$READ^BDGF("NO^1:3","Select Date Range Type","","","",.BSDA)
+7 IF (BSDATE=U)!(BSDATE="")
QUIT
+8 SET BSDATE=$PIECE($TEXT(DATE+BSDATE),";;",2,3)
SET BSDATE=$PIECE(BSDATE,";;",2)_U_$PIECE(BSDATE,";;")
+9 ;
+10 WRITE !
SET BSDBD=$$READ^BDGF("DO^::EX","Select Beginning Date")
IF BSDBD<1
QUIT
+11 SET BSDED=$$READ^BDGF("DO^::EX","Select Ending Date")
IF BSDED<1
QUIT
+12 ;
+13 ;I BSDATE=".07" S BSDREM=1 ;include removed entries
+14 ;include removed entries ;IHS/OIT/LJF 7/22/2005 PATCH 1004
IF $PIECE(BSDATE,U)=".07"
SET BSDREM=1
+15 IF '$TEST
WRITE !
SET BSDREM=$$READ^BDGF("Y","Include Entries Already Removed from List","NO")
+16 IF BSDREM=U
QUIT
+17 ;
+18 WRITE !!
KILL BSDA
FOR I=1:1:5
SET BSDA(I)=$JUSTIFY(I,4)_") "_$PIECE($TEXT(SORT+I),";;",2)
+19 SET BSDSRT=$$READ^BDGF("NO^1:5","Select Sort","","","",.BSDA)
+20 IF (BSDSRT=U)!(BSDSRT="")
QUIT
+21 ;sorting by date
IF BSDSRT=1
SET BSDSRT=BSDSRT_U_BSDATE
+22 ;sort field
IF '$TEST
SET BSDSRT=BSDSRT_U_$PIECE($TEXT(SORT+BSDSRT),";;",3)
+23 ;
+24 ;cmi/anch/maw added patch 1007 item 1007.28
+25 SET BSDPRTYN=$$READ^BDGF("Y","Select item to Print By","NO")
+26 KILL BSDSEL
+27 IF $GET(BSDPRTYN)
Begin DoDot:1
+28 WRITE !!
KILL BSDA
FOR I=1:1:5
SET BSDA(I)=$JUSTIFY(I,4)_") "_$PIECE($TEXT(SORT+I),";;",2)
+29 SET BSDPRTB=$$READ^BDGF("NO^1:5","Print By","","","",.BSDA)
+30 IF (BSDPRTB=U)!(BSDPRTB="")
QUIT
+31 ;printing by date
IF BSDPRTB=1
SET BSDPRTB=BSDPRTB_U_BSDATE
+32 ;print field
IF BSDPRTB'=1
Begin DoDot:2
+33 IF BSDPRTB=2
DO PRI
QUIT
+34 IF BSDPRTB=3
DO PROV
QUIT
+35 IF BSDPRTB=4
DO REA
QUIT
+36 IF BSDPRTB=5
DO RES
QUIT
End DoDot:2
End DoDot:1
+37 IF '$GET(BSDSEL)
KILL BSDPRTYN
+38 ;cmi/anch/maw end of mods
+39 ;
+40 ;IHS/OIT/LJF 8.31.2005 PATCH 1004 check for user ^ out too
+41 ;I $$BROWSE^BDGF="B" D EN^BSDWLL Q
+42 SET X=$$BROWSE^BDGF
IF X=U
QUIT
+43 IF X="B"
DO EN^BSDWLL
QUIT
+44 ;
+45 ;IHS/OIT/LJF 7/21/2005 PATCH 1004
+46 NEW BSDPAG
SET BSDPAG=$$READ^BDGF("Y","Print each "_$PIECE($TEXT(SORT+BSDSRT),";;",4)_" on separate piece of paper","NO")
IF BSDPAG=U
QUIT
+47 ;
+48 DO ZIS^BDGF("PQ","EN^BSDWLL","Waiting List Report","BSD*")
+49 QUIT
+50 ;
PRI ;-- get priority
+1 ;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
+2 SET DIR(0)="S^"_$PIECE(^DD(9009017.11,.02,0),U,3)
SET DIR("A")="Select Priority: "
+3 DO ^DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET BSDPRI(+Y)=""
+6 SET BSDSEL=1
+7 NEW BSDAN
+8 SET BSDAN=$$READ^BDGF("Y","Select Another","NO")
+9 IF $GET(BSDAN)
GOTO PRI
+10 QUIT
+11 ;
PROV ;--get provider(s)
+1 ;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
+2 SET DIC(0)="AEMQZ"
SET DIC=200
SET DIC("A")="Select Provider: "
+3 DO ^DIC
+4 IF '+$GET(Y)
QUIT
+5 SET BSDPROV(+Y)=""
+6 SET BSDSEL=1
+7 NEW BSDAN
+8 SET BSDAN=$$READ^BDGF("Y","Select Another","NO")
+9 IF $GET(BSDAN)
GOTO PROV
+10 QUIT
+11 ;
REA ;-- get reason(s)
+1 ;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
+2 SET DIC(0)="AEMQZ"
SET DIC=9009017.4
SET DIC("A")="Select Reason: "
+3 DO ^DIC
+4 IF '+$GET(Y)
QUIT
+5 SET BSDREA(+Y)=""
+6 SET BSDSEL=1
+7 NEW BSDAN
+8 SET BSDAN=$$READ^BDGF("Y","Select Another","NO")
+9 IF $GET(BSDAN)
GOTO REA
+10 QUIT
+11 ;
RES ;-- get resolution(s)
+1 ;cmi/anch/maw added 1/15/2007 PATCH 1007 item 1007.28
+2 SET DIC(0)="AEMQZ"
SET DIC=9009017.4
SET DIC("A")="Select Resolution: "
+3 DO ^DIC
+4 IF '+$GET(Y)
QUIT
+5 SET BSDRES(+Y)=""
+6 SET BSDSEL=1
+7 NEW BSDAN
+8 SET BSDAN=$$READ^BDGF("Y","Select Another","NO")
+9 IF $GET(BSDAN)
GOTO RES
+10 QUIT
+11 ;
DATE ;;
+1 ;;Date Added to List;;.03;;
+2 ;;Recall Date;;.05;;
+3 ;;Date Removed from List;;.07;;
+4 ;;
SORT ;;
+1 ;;By Dates Selected;;;;DATE
+2 ;;By Priority;;.02;;PRIORITY
+3 ;;By Provider;;.06;;PROVIDER
+4 ;;By Reason Added;;.09;;REASON
+5 ;;By Resolution;;.08;;RESOLUTION
