source: FOIAVistA/tag/r/WOMENS_HEALTH-WV/WVBRPCD2.m@ 628

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