WVBRPCD2 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES;
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; PROMPTS FOR SELECTION CRITERIA IN BROWSING PROCEDURES.
;; CALLED BY WVBRPCD.
;
D TITLE^WVUTL5("BROWSE PROCEDURES")
D ONEALL Q:WVPOP
D SELECT Q:WVPOP
D DATES Q:WVPOP
D STATUS Q:WVPOP
D RESULT Q:WVPOP
D CMGR Q:WVPOP
D ORDER Q:WVPOP
D DEVICE Q:WVPOP
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^WVBRPCD3
D ^DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
;---> IF ALL PATIENTS, S WVA=1 AND QUIT.
I Y="a" S WVA=1 Q
;
W !!," Select the patient whose Procedures you wish to browse."
D PATLKUP^WVUTL8(.Y)
I Y<0 S WVPOP=1 Q
;---> FOR ONE PATIENT, SET WVA=0 AND WVDFN=PATIENT DFN, QUIT.
S WVDFN=+Y,WVA=0,WVCMGR=$P(^WV(790,WVDFN,0),U,10)
Q
;
SELECT ;EP
;---> SELECT THE PROCEDURES TO BROWSE.
D SELECT^WVSELECT("Procedure Type",790.2,"WVARR","","PAP",.WVPOP)
Q
;
DATES ;EP
;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-365.
S WVBEGDF=$S(WVA:"T-30",1:"T-365")
D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,WVBEGDF,"T")
Q
;
STATUS ;EP
;---> GET XREF: OPEN OR ALL
N DIR,DIRUT,Y W !!?3
W "Do you wish to browse DELINQUENT, OPEN, or ALL Procedures?"
S DIR("A")=" Select DELINQUENT, OPEN or ALL: ",DIR("B")="OPEN"
S DIR(0)="SAM^d:DELINQUENT;o:OPEN;a:ALL" D HELP4^WVBRPCD3
D ^DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
S WVB=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^WVBRPCD3
S DIR(0)="SAM^a:ABNORMAL ONLY;b:BOTH ABNORMAL AND NORMAL"
D ^DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
S WVD=$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(^WV(790.02,DUZ(2),0)) S WVE=1 Q
I '$P(^WV(790.02,DUZ(2),0),U,5)!('WVA) S WVE=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^WVBRPCD3
D ^DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
I Y="a" S WVE=1 Q
N DIC
W !!," Select the Case Manager whose patients you wish to browse."
D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
I Y<0 S WVPOP=1 Q
;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVCMGR=^VA(200 DFN, QUIT.
S WVCMGR=+Y,WVE=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 'WVA S WVC=1 D TITLE Q
;
;---> SORT SEQUENCE IN WVC: 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^WVBRPCD3
D ^DIR
I Y=-1!($D(DIRUT)) S WVPOP=1 Q
S WVC=Y D TITLE
Q
;
TITLE ;EP
;---> SET TITLE OF REPORT BASED ON ORDER SELECTED ABOVE.
N Y S Y=$S(WVC=1:"DATE",WVC=2:"PATIENT",WVC=3:"DIAGNOSIS",1:"?")
S WVTITLE="* * * PROCEDURES LISTED BY "_Y_" * * *"
S WVCODE="D EDIT^WVBRPCD1,SORT^WVBRPCD,COPYGBL^WVBRPCD"
S WVHEADER="HEADER1"
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DEQUEUE^WVBRPCD"
F WVSV="A","B","C","CODE","D","E","CMGR" D
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
F WVSV="DFN","BEGDT","ENDDT","HEADER","TITLE" D
.I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
;---> SAVE THE SELECTED PROCEDURES ARRAY.
I $D(WVARR) N N S N=0 F S N=$O(WVARR(N)) Q:N="" D
.S ZTSAVE("WVARR("""_N_""")")=""
D ZIS^WVUTL2(.WVPOP,1,"HOME")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVBRPCD2 4476 printed Nov 22, 2024@17:56:41 Page 2
WVBRPCD2 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES;
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; PROMPTS FOR SELECTION CRITERIA IN BROWSING PROCEDURES.
+4 ;; CALLED BY WVBRPCD.
+5 ;
+6 DO TITLE^WVUTL5("BROWSE PROCEDURES")
+7 DO ONEALL
if WVPOP
QUIT
+8 DO SELECT
if WVPOP
QUIT
+9 DO DATES
if WVPOP
QUIT
+10 DO STATUS
if WVPOP
QUIT
+11 DO RESULT
if WVPOP
QUIT
+12 DO CMGR
if WVPOP
QUIT
+13 DO ORDER
if WVPOP
QUIT
+14 DO DEVICE
if WVPOP
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^WVBRPCD3
+7 DO ^DIR
+8 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+9 ;---> IF ALL PATIENTS, S WVA=1 AND QUIT.
+10 IF Y="a"
SET WVA=1
QUIT
+11 ;
+12 WRITE !!," Select the patient whose Procedures you wish to browse."
+13 DO PATLKUP^WVUTL8(.Y)
+14 IF Y<0
SET WVPOP=1
QUIT
+15 ;---> FOR ONE PATIENT, SET WVA=0 AND WVDFN=PATIENT DFN, QUIT.
+16 SET WVDFN=+Y
SET WVA=0
SET WVCMGR=$PIECE(^WV(790,WVDFN,0),U,10)
+17 QUIT
+18 ;
SELECT ;EP
+1 ;---> SELECT THE PROCEDURES TO BROWSE.
+2 DO SELECT^WVSELECT("Procedure Type",790.2,"WVARR","","PAP",.WVPOP)
+3 QUIT
+4 ;
DATES ;EP
+1 ;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
+2 ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-365.
+3 SET WVBEGDF=$SELECT(WVA:"T-30",1:"T-365")
+4 DO ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,WVBEGDF,"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, OPEN, or ALL Procedures?"
+4 SET DIR("A")=" Select DELINQUENT, OPEN or ALL: "
SET DIR("B")="OPEN"
+5 SET DIR(0)="SAM^d:DELINQUENT;o:OPEN;a:ALL"
DO HELP4^WVBRPCD3
+6 DO ^DIR
+7 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+8 SET WVB=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^WVBRPCD3
+7 SET DIR(0)="SAM^a:ABNORMAL ONLY;b:BOTH ABNORMAL AND NORMAL"
+8 DO ^DIR
+9 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+10 SET WVD=$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(^WV(790.02,DUZ(2),0))
SET WVE=1
QUIT
+6 IF '$PIECE(^WV(790.02,DUZ(2),0),U,5)!('WVA)
SET WVE=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^WVBRPCD3
+11 DO ^DIR
+12 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+13 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
+14 IF Y="a"
SET WVE=1
QUIT
+15 NEW DIC
+16 WRITE !!," Select the Case Manager whose patients you wish to browse."
+17 DO DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
+18 IF Y<0
SET WVPOP=1
QUIT
+19 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVCMGR=^VA(200 DFN, QUIT.
+20 SET WVCMGR=+Y
SET WVE=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 'WVA
SET WVC=1
DO TITLE
QUIT
+4 ;
+5 ;---> SORT SEQUENCE IN WVC: 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^WVBRPCD3
+16 DO ^DIR
+17 IF Y=-1!($DATA(DIRUT))
SET WVPOP=1
QUIT
+18 SET WVC=Y
DO TITLE
+19 QUIT
+20 ;
TITLE ;EP
+1 ;---> SET TITLE OF REPORT BASED ON ORDER SELECTED ABOVE.
+2 NEW Y
SET Y=$SELECT(WVC=1:"DATE",WVC=2:"PATIENT",WVC=3:"DIAGNOSIS",1:"?")
+3 SET WVTITLE="* * * PROCEDURES LISTED BY "_Y_" * * *"
+4 SET WVCODE="D EDIT^WVBRPCD1,SORT^WVBRPCD,COPYGBL^WVBRPCD"
+5 SET WVHEADER="HEADER1"
+6 QUIT
+7 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DEQUEUE^WVBRPCD"
+3 FOR WVSV="A","B","C","CODE","D","E","CMGR"
Begin DoDot:1
+4 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+5 FOR WVSV="DFN","BEGDT","ENDDT","HEADER","TITLE"
Begin DoDot:1
+6 IF $DATA(@("WV"_WVSV))
SET ZTSAVE("WV"_WVSV)=""
End DoDot:1
+7 ;---> SAVE THE SELECTED PROCEDURES ARRAY.
+8 IF $DATA(WVARR)
NEW N
SET N=0
FOR
SET N=$ORDER(WVARR(N))
if N=""
QUIT
Begin DoDot:1
+9 SET ZTSAVE("WVARR("""_N_""")")=""
End DoDot:1
+10 DO ZIS^WVUTL2(.WVPOP,1,"HOME")
+11 QUIT
