Routine: WVBRPCD2

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

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)

SELECT ;EP

 ;---> SELECT THE PROCEDURES TO BROWSE.

 D SELECT^WVSELECT("Procedure Type",790.2,"WVARR","","PAP",.WVPOP)

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")

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

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)

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

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

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"

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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVBRPCD2   4476     printed  Feb 19, 2025@00:13:17                                                                                                                                                                                                    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

WVBRPCD2.m