BSDWL.m

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