BWBRPCD2.m

BWBRPCD2 ;IHS/ANMC/MWR - BROWSE PROCEDURES;15-Feb-2003 21:49;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  PROMPTS FOR SELECTION CRITERIA IN BROWSING PROCEDURES.

 ;;  CALLED BY BWBRPCD.

 ;

 D TITLE^BWUTL5("BROWSE PROCEDURES")

 D ONEALL Q:BWPOP

 D SELECT Q:BWPOP

 D DATES  Q:BWPOP

 D STATUS Q:BWPOP

 D RESULT Q:BWPOP

 D CMGR   Q:BWPOP

 D ORDER  Q:BWPOP

 D DEVICE Q:BWPOP

 Q

 ;

ONEALL ;EP

 ;---> SELECT ONE PATIENT OR ALL PATIENTS.

 N DIR,DIRUT,Y

 W !!?3,"Browse Procedures for ONE individual patient,"

 W !?3,"or browse Procedures for ALL patients?"

 S DIR("A")="   Select ONE or ALL: ",DIR("B")="ALL"

 S DIR(0)="SAM^o:ONE;a:ALL" D HELP2^BWBRPCD3

 D ^DIR

 I Y=-1!($D(DIRUT)) S BWPOP=1 Q

 ;---> IF ALL PATIENTS, S BWA=1 AND QUIT.

 I Y="a" S BWA=1 Q

 ;

 W !!,"   Select the patient whose Procedures you wish to browse."

 D PATLKUP^BWUTL8(.Y)

 I Y<0 S BWPOP=1 Q

 ;---> FOR ONE PATIENT, SET BWA=0 AND BWDFN=PATIENT DFN, QUIT.

 S BWDFN=+Y,BWA=0,BWCMGR=$P(^BWP(BWDFN,0),U,10)

 Q

 ;

SELECT ;EP

 ;---> SELECT THE PROCEDURES TO BROWSE.

 D SELECT^BWSELECT("Procedure Type",9002086.2,"BWARR","","PAP",.BWPOP)

 Q

 ;

DATES ;EP

 ;---> ASK DATE RANGE.  RETURN DATES IN BWBEGDT AND BWENDDT.

 ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-365.

 S BWBEGDF=$S(BWA:"T-30",1:"T-365")

 D ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,BWBEGDF,"T")

 Q

 ;

STATUS ;EP

 ;---> GET XREF: OPEN OR ALL

 N DIR,DIRUT,Y W !!?3

 W "Do you wish to browse DELINQUENT, NEW, OPEN, or ALL Procedures?"

 S DIR("A")="   Select DELINQUENT, NEW, OPEN or ALL: ",DIR("B")="OPEN"

 S DIR(0)="SAM^d:DELINQUENT;n:NEW;o:OPEN;a:ALL" D HELP4^BWBRPCD3

 D ^DIR

 I Y=-1!($D(DIRUT)) S BWPOP=1 Q

 S BWB=Y

 Q

 ;

RESULT ;EP

 ;---> GET XREF: ABNORMAL OR ALL

 N DIR,DIRUT,Y

 W !!?3,"Do you wish to browse only Procedures with ABNORMAL results, "

 W !?3,"or both ABNORMAL and NORMAL?"

 S DIR("A")="   Select ABNORMAL or BOTH: "

 S DIR("B")="ABNORMAL ONLY" D HELP1^BWBRPCD3

 S DIR(0)="SAM^a:ABNORMAL ONLY;b:BOTH ABNORMAL AND NORMAL"

 D ^DIR

 I Y=-1!($D(DIRUT)) S BWPOP=1 Q

 S BWD=$S(Y="a":0,1:1)

 Q

 ;

CMGR ;EP

 ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.

 ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO,

 ;---> OR IF LOOKING AT PROCEDURES FOR ONLY ONE PATIENT.

 N DIR,DIRUT,Y

 I '$D(^BWSITE(DUZ(2),0)) S BWE=1 Q

 I '$P(^BWSITE(DUZ(2),0),U,5)!('BWA) S BWE=1 Q

 W !!?3,"Browse Procedures for ONE particular Case Manager,"

 W !?3,"or browse Procedures for ALL Case Managers?"

 S DIR("A")="   Select ONE or ALL: ",DIR("B")="ALL"

 S DIR(0)="SAM^o:ONE;a:ALL" D HELP5^BWBRPCD3

 D ^DIR

 I Y=-1!($D(DIRUT)) S BWPOP=1 Q

 ;---> IF ALL CASE MANAGERS, S BWE=1 AND QUIT.

 I Y="a" S BWE=1 Q

 N DIC

 W !!,"   Select the Case Manager whose patients you wish to browse."

 D DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select CASE MANAGER: ")

 I Y<0 S BWPOP=1 Q

 ;---> FOR ONE CASE MANAGER, SET BWE=0 AND BWCMGR=^VA(200 DFN, QUIT.

 S BWCMGR=+Y,BWE=0

 Q

 ;

ORDER ;EP

 ;---> ASK ORDER BY DATE OR BY PATIENT OR BY PRIORITY.

 ;---> IF LOOKING AT ONLY ONE PATIENT, ORDER BY DATE AND QUIT.

 I 'BWA S BWC=1 D TITLE Q

 ;

 ;---> SORT SEQUENCE IN BWC:  1=DATE, PATIENT, PRIORITY

 ;--->                        2=PATIENT, DATE, PRIORITY

 ;--->                        3=PRIORITY, DATE, PATIENT

 ;

 N DIR,DIRUT,Y

 W !!?3,"Display Procedures in order of:"

 W ?37,"1) DATE OF PROCEDURE (earliest first)"

 W !?37,"2) NAME OF PATIENT (alphabetically)"

 W !?37,"3) PRIORITY (most urgent being highest)"

 S DIR("A")="   Select 1, 2, or 3: ",DIR("B")=1

 S DIR(0)="SAM^1:DATE;2:NAME;3:PRIORITY" D HELP3^BWBRPCD3

 D ^DIR

 I Y=-1!($D(DIRUT)) S BWPOP=1 Q

 S BWC=Y D TITLE

 Q

 ;

TITLE ;EP

 ;---> SET TITLE OF REPORT BASED ON ORDER SELECTED ABOVE.

 N Y S Y=$S(BWC=1:"DATE",BWC=2:"PATIENT",BWC=3:"DIAGNOSIS",1:"?")

 S BWTITLE="* * *  PROCEDURES LISTED BY "_Y_"  * * *"

 S BWCODE="D EDIT^BWBRPCD1,SORT^BWBRPCD,COPYGBL^BWBRPCD"

 S BWHEADER="HEADER1"

 Q

 ;

DEVICE ;EP

 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 S ZTRTN="DEQUEUE^BWBRPCD"

 F BWSV="A","B","C","CODE","D","E","CMGR" D

 .I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""

 F BWSV="DFN","BEGDT","ENDDT","HEADER","TITLE" D

 .I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""

 ;---> SAVE THE SELECTED PROCEDURES ARRAY.

 I $D(BWARR) N N S N=0 F  S N=$O(BWARR(N)) Q:N=""  D

 .S ZTSAVE("BWARR("""_N_""")")=""

 D ZIS^BWUTL2(.BWPOP,1,"HOME")

 Q

BWBRPCD2  ;IHS/ANMC/MWR - BROWSE PROCEDURES;15-Feb-2003 21:49;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  PROMPTS FOR SELECTION CRITERIA IN BROWSING PROCEDURES.

 +4       ;;  CALLED BY BWBRPCD.

 +5       ;

 +6        DO TITLE^BWUTL5("BROWSE PROCEDURES")

 +7        DO ONEALL

           IF BWPOP

               QUIT 

 +8        DO SELECT

           IF BWPOP

               QUIT 

 +9        DO DATES

           IF BWPOP

               QUIT 

 +10       DO STATUS

           IF BWPOP

               QUIT 

 +11       DO RESULT

           IF BWPOP

               QUIT 

 +12       DO CMGR

           IF BWPOP

               QUIT 

 +13       DO ORDER

           IF BWPOP

               QUIT 

 +14       DO DEVICE

           IF BWPOP

               QUIT 

 +15       QUIT 

 +16      ;

ONEALL    ;EP

 +1       ;---> SELECT ONE PATIENT OR ALL PATIENTS.

 +2        NEW DIR,DIRUT,Y

 +3        WRITE !!?3,"Browse Procedures for ONE individual patient,"

 +4        WRITE !?3,"or browse Procedures for ALL patients?"

 +5        SET DIR("A")="   Select ONE or ALL: "

           SET DIR("B")="ALL"

 +6        SET DIR(0)="SAM^o:ONE;a:ALL"

           DO HELP2^BWBRPCD3

 +7        DO ^DIR

 +8        IF Y=-1!($DATA(DIRUT))

               SET BWPOP=1

               QUIT 

 +9       ;---> IF ALL PATIENTS, S BWA=1 AND QUIT.

 +10       IF Y="a"

               SET BWA=1

               QUIT 

 +11      ;

 +12       WRITE !!,"   Select the patient whose Procedures you wish to browse."

 +13       DO PATLKUP^BWUTL8(.Y)

 +14       IF Y<0

               SET BWPOP=1

               QUIT 

 +15      ;---> FOR ONE PATIENT, SET BWA=0 AND BWDFN=PATIENT DFN, QUIT.

 +16       SET BWDFN=+Y

           SET BWA=0

           SET BWCMGR=$PIECE(^BWP(BWDFN,0),U,10)

 +17       QUIT 

 +18      ;

SELECT    ;EP

 +1       ;---> SELECT THE PROCEDURES TO BROWSE.

 +2        DO SELECT^BWSELECT("Procedure Type",9002086.2,"BWARR","","PAP",.BWPOP)

 +3        QUIT 

 +4       ;

DATES     ;EP

 +1       ;---> ASK DATE RANGE.  RETURN DATES IN BWBEGDT AND BWENDDT.

 +2       ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-365.

 +3        SET BWBEGDF=$SELECT(BWA:"T-30",1:"T-365")

 +4        DO ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,BWBEGDF,"T")

 +5        QUIT 

 +6       ;

STATUS    ;EP

 +1       ;---> GET XREF: OPEN OR ALL

 +2        NEW DIR,DIRUT,Y

           WRITE !!?3

 +3        WRITE "Do you wish to browse DELINQUENT, NEW, OPEN, or ALL Procedures?"

 +4        SET DIR("A")="   Select DELINQUENT, NEW, OPEN or ALL: "

           SET DIR("B")="OPEN"

 +5        SET DIR(0)="SAM^d:DELINQUENT;n:NEW;o:OPEN;a:ALL"

           DO HELP4^BWBRPCD3

 +6        DO ^DIR

 +7        IF Y=-1!($DATA(DIRUT))

               SET BWPOP=1

               QUIT 

 +8        SET BWB=Y

 +9        QUIT 

 +10      ;

RESULT    ;EP

 +1       ;---> GET XREF: ABNORMAL OR ALL

 +2        NEW DIR,DIRUT,Y

 +3        WRITE !!?3,"Do you wish to browse only Procedures with ABNORMAL results, "

 +4        WRITE !?3,"or both ABNORMAL and NORMAL?"

 +5        SET DIR("A")="   Select ABNORMAL or BOTH: "

 +6        SET DIR("B")="ABNORMAL ONLY"

           DO HELP1^BWBRPCD3

 +7        SET DIR(0)="SAM^a:ABNORMAL ONLY;b:BOTH ABNORMAL AND NORMAL"

 +8        DO ^DIR

 +9        IF Y=-1!($DATA(DIRUT))

               SET BWPOP=1

               QUIT 

 +10       SET BWD=$SELECT(Y="a":0,1:1)

 +11       QUIT 

 +12      ;

CMGR      ;EP

 +1       ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.

 +2       ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO,

 +3       ;---> OR IF LOOKING AT PROCEDURES FOR ONLY ONE PATIENT.

 +4        NEW DIR,DIRUT,Y

 +5        IF '$DATA(^BWSITE(DUZ(2),0))

               SET BWE=1

               QUIT 

 +6        IF '$PIECE(^BWSITE(DUZ(2),0),U,5)!('BWA)

               SET BWE=1

               QUIT 

 +7        WRITE !!?3,"Browse Procedures for ONE particular Case Manager,"

 +8        WRITE !?3,"or browse Procedures for ALL Case Managers?"

 +9        SET DIR("A")="   Select ONE or ALL: "

           SET DIR("B")="ALL"

 +10       SET DIR(0)="SAM^o:ONE;a:ALL"

           DO HELP5^BWBRPCD3

 +11       DO ^DIR

 +12       IF Y=-1!($DATA(DIRUT))

               SET BWPOP=1

               QUIT 

 +13      ;---> IF ALL CASE MANAGERS, S BWE=1 AND QUIT.

 +14       IF Y="a"

               SET BWE=1

               QUIT 

 +15       NEW DIC

 +16       WRITE !!,"   Select the Case Manager whose patients you wish to browse."

 +17       DO DIC^BWFMAN(9002086.01,"QEMA",.Y,"   Select CASE MANAGER: ")

 +18       IF Y<0

               SET BWPOP=1

               QUIT 

 +19      ;---> FOR ONE CASE MANAGER, SET BWE=0 AND BWCMGR=^VA(200 DFN, QUIT.

 +20       SET BWCMGR=+Y

           SET BWE=0

 +21       QUIT 

 +22      ;

ORDER     ;EP

 +1       ;---> ASK ORDER BY DATE OR BY PATIENT OR BY PRIORITY.

 +2       ;---> IF LOOKING AT ONLY ONE PATIENT, ORDER BY DATE AND QUIT.

 +3        IF 'BWA

               SET BWC=1

               DO TITLE

               QUIT 

 +4       ;

 +5       ;---> SORT SEQUENCE IN BWC:  1=DATE, PATIENT, PRIORITY

 +6       ;--->                        2=PATIENT, DATE, PRIORITY

 +7       ;--->                        3=PRIORITY, DATE, PATIENT

 +8       ;

 +9        NEW DIR,DIRUT,Y

 +10       WRITE !!?3,"Display Procedures in order of:"

 +11       WRITE ?37,"1) DATE OF PROCEDURE (earliest first)"

 +12       WRITE !?37,"2) NAME OF PATIENT (alphabetically)"

 +13       WRITE !?37,"3) PRIORITY (most urgent being highest)"

 +14       SET DIR("A")="   Select 1, 2, or 3: "

           SET DIR("B")=1

 +15       SET DIR(0)="SAM^1:DATE;2:NAME;3:PRIORITY"

           DO HELP3^BWBRPCD3

 +16       DO ^DIR

 +17       IF Y=-1!($DATA(DIRUT))

               SET BWPOP=1

               QUIT 

 +18       SET BWC=Y

           DO TITLE

 +19       QUIT 

 +20      ;

TITLE     ;EP

 +1       ;---> SET TITLE OF REPORT BASED ON ORDER SELECTED ABOVE.

 +2        NEW Y

           SET Y=$SELECT(BWC=1:"DATE",BWC=2:"PATIENT",BWC=3:"DIAGNOSIS",1:"?")

 +3        SET BWTITLE="* * *  PROCEDURES LISTED BY "_Y_"  * * *"

 +4        SET BWCODE="D EDIT^BWBRPCD1,SORT^BWBRPCD,COPYGBL^BWBRPCD"

 +5        SET BWHEADER="HEADER1"

 +6        QUIT 

 +7       ;

DEVICE    ;EP

 +1       ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 +2        SET ZTRTN="DEQUEUE^BWBRPCD"

 +3        FOR BWSV="A","B","C","CODE","D","E","CMGR"

               Begin DoDot:1

 +4                IF $DATA(@("BW"_BWSV))

                       SET ZTSAVE("BW"_BWSV)=""

               End DoDot:1

 +5        FOR BWSV="DFN","BEGDT","ENDDT","HEADER","TITLE"

               Begin DoDot:1

 +6                IF $DATA(@("BW"_BWSV))

                       SET ZTSAVE("BW"_BWSV)=""

               End DoDot:1

 +7       ;---> SAVE THE SELECTED PROCEDURES ARRAY.

 +8        IF $DATA(BWARR)

               NEW N

               SET N=0

               FOR 

                   SET N=$ORDER(BWARR(N))

                   IF N=""

                       QUIT 

                   Begin DoDot:1

 +9                    SET ZTSAVE("BWARR("""_N_""")")=""

                   End DoDot:1

 +10       DO ZIS^BWUTL2(.BWPOP,1,"HOME")

 +11       QUIT