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
