BWBRMDE.m

BWBRMDE ;IHS/ANMC/MWR - BROWSE PROCEDURES FOR CDC MDE'S;15-Feb-2003 21:47;PLS

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

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

 ;;  CALLED BY OPTION: "BW CDC BROWSE PROCEDURES NO DX" TO

 ;;  LIST AND BROWSE PROCEDURES WITH INCOMPLETE DX WORKUP.

 ;

 ;---> USE ^BWBRPCD ROUTINES FOR DISPLAY (NODES 1 & 2 IN ^TMP GLOBAL).

 ;

 D SETVARS

 D DATES  G:BWPOP EXIT

 D DEVICE G:BWPOP EXIT

 D SORT

 D COPYGBL^BWBRPCD

 D DISPLAY^BWBRPCD1(BWTITLE,BWHEADER,BWCODE)

 ;

EXIT ;EP

 W:$D(IOF) @IOF

 D KILLALL^BWUTL8

 Q

 ;

SETVARS ;EP

 ;---> SET REQUIRED VARIABLES.

 D SETVARS^BWUTL5 S BWPOP=0

 S BWTITLE="* * *  MDE PROCEDURES WITH INCOMPLTE DX WORKUP * * *"

 ;---> SET CODE EXCECUTED BY DIR PROMPT.

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

 ;---> SET LINE LABEL IN ^BWUTL7 TO CALL AS HEADER.

 S BWHEADER="HEADER1"

 Q

 ;

SORT ;EP

 ;---> SORT AND STORE ARRAY IN ^TMP("BW",$J

 K ^TMP("BW",$J) N BWDFN,BWIEN,BWPCD,BWPCDS,N,M,P,Y,Z

 S BWDATE=BWBEGDT-.00001,BWENDDT=BWENDDT+1

 F  S BWDATE=$O(^BWPCD("D",BWDATE)) Q:'BWDATE  Q:(BWDATE'<BWENDDT)  D

 .S BWIEN=0

 .F  S BWIEN=$O(^BWPCD("D",BWDATE,BWIEN)) Q:'BWIEN  D

 ..;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE, Z=THE 2 NODE.

 ..S Y=^BWPCD(BWIEN,0),Z=$G(^BWPCD(BWIEN,2))

 ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".

 ..Q:$P(Y,U,5)=8

 ..;---> QUIT IF PIECE 2;20, DX WORKUP PLANNED IS NEITHER

 ..;---> 1:PLANNED NOR 3:UNDETERMINED.

 ..Q:Z=""  Q:(($P(Z,U,20)'=1)&($P(Z,U,20)'=3))

 ..;---> QUIT IF EITHER FIELD 0;33 (FINAL DX PAP/COLP) OR

 ..;---> FIELD 2;3 (FINAL DX FOR BREAST) IS NOT NULL, I.E., A FINAL

 ..;---> DIAGNOSIS HAS BEEN ENTERED.

 ..Q:(($P(Y,U,33)]"")!($P(Z,U,30)]""))

 ..;---> STORE IN ^TMP FOR DISPLAY.

 ..S Y=^BWPCD(BWIEN,0) D STORE^BWBRPCD(1,BWIEN,Y)

 Q

 ;

DEQUEUE ;EP

 ;---> FOR TASKMAN QUEUE OF PRINTOUT.

 D SETVARS,SORT,COPYGBL^BWBRPCD

 D DISPLAY^BWBRPCD1(BWTITLE,BWHEADER,BWCODE)

 D EXIT

 Q

 ;

DATES ;EP

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

 ;---> SET DEFAULT BEGIN DATE=DATE CDC FUNDING BEGAN (SITE PARAM).

 S:$G(DUZ(2)) BWBEGDF=$$TXDT^BWUTL5($P($G(^BWSITE(DUZ(2),0)),U,17))

 ;

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

 Q

 ;

DEVICE ;EP

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

 S ZTRTN="DEQUEUE^BWBRMDE"

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

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

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

 Q

BWBRMDE   ;IHS/ANMC/MWR - BROWSE PROCEDURES FOR CDC MDE'S;15-Feb-2003 21:47;PLS

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

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

 +3       ;;  CALLED BY OPTION: "BW CDC BROWSE PROCEDURES NO DX" TO

 +4       ;;  LIST AND BROWSE PROCEDURES WITH INCOMPLETE DX WORKUP.

 +5       ;

 +6       ;---> USE ^BWBRPCD ROUTINES FOR DISPLAY (NODES 1 & 2 IN ^TMP GLOBAL).

 +7       ;

 +8        DO SETVARS

 +9        DO DATES

           IF BWPOP

               GOTO EXIT

 +10       DO DEVICE

           IF BWPOP

               GOTO EXIT

 +11       DO SORT

 +12       DO COPYGBL^BWBRPCD

 +13       DO DISPLAY^BWBRPCD1(BWTITLE,BWHEADER,BWCODE)

 +14      ;

EXIT      ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        DO KILLALL^BWUTL8

 +3        QUIT 

 +4       ;

SETVARS   ;EP

 +1       ;---> SET REQUIRED VARIABLES.

 +2        DO SETVARS^BWUTL5

           SET BWPOP=0

 +3        SET BWTITLE="* * *  MDE PROCEDURES WITH INCOMPLTE DX WORKUP * * *"

 +4       ;---> SET CODE EXCECUTED BY DIR PROMPT.

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

 +6       ;---> SET LINE LABEL IN ^BWUTL7 TO CALL AS HEADER.

 +7        SET BWHEADER="HEADER1"

 +8        QUIT 

 +9       ;

SORT      ;EP

 +1       ;---> SORT AND STORE ARRAY IN ^TMP("BW",$J

 +2        KILL ^TMP("BW",$JOB)

           NEW BWDFN,BWIEN,BWPCD,BWPCDS,N,M,P,Y,Z

 +3        SET BWDATE=BWBEGDT-.00001

           SET BWENDDT=BWENDDT+1

 +4        FOR 

               SET BWDATE=$ORDER(^BWPCD("D",BWDATE))

               IF 'BWDATE

                   QUIT 

               IF (BWDATE'<BWENDDT)

                   QUIT 

               Begin DoDot:1

 +5                SET BWIEN=0

 +6                FOR 

                       SET BWIEN=$ORDER(^BWPCD("D",BWDATE,BWIEN))

                       IF 'BWIEN

                           QUIT 

                       Begin DoDot:2

 +7       ;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE, Z=THE 2 NODE.

 +8                        SET Y=^BWPCD(BWIEN,0)

                           SET Z=$GET(^BWPCD(BWIEN,2))

 +9       ;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".

 +10                       IF $PIECE(Y,U,5)=8

                               QUIT 

 +11      ;---> QUIT IF PIECE 2;20, DX WORKUP PLANNED IS NEITHER

 +12      ;---> 1:PLANNED NOR 3:UNDETERMINED.

 +13                       IF Z=""

                               QUIT 

                           IF (($PIECE(Z,U,20)'=1)&($PIECE(Z,U,20)'=3))

                               QUIT 

 +14      ;---> QUIT IF EITHER FIELD 0;33 (FINAL DX PAP/COLP) OR

 +15      ;---> FIELD 2;3 (FINAL DX FOR BREAST) IS NOT NULL, I.E., A FINAL

 +16      ;---> DIAGNOSIS HAS BEEN ENTERED.

 +17                       IF (($PIECE(Y,U,33)]"")!($PIECE(Z,U,30)]""))

                               QUIT 

 +18      ;---> STORE IN ^TMP FOR DISPLAY.

 +19                       SET Y=^BWPCD(BWIEN,0)

                           DO STORE^BWBRPCD(1,BWIEN,Y)

                       End DoDot:2

               End DoDot:1

 +20       QUIT 

 +21      ;

DEQUEUE   ;EP

 +1       ;---> FOR TASKMAN QUEUE OF PRINTOUT.

 +2        DO SETVARS

           DO SORT

           DO COPYGBL^BWBRPCD

 +3        DO DISPLAY^BWBRPCD1(BWTITLE,BWHEADER,BWCODE)

 +4        DO EXIT

 +5        QUIT 

 +6       ;

DATES     ;EP

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

 +2       ;---> SET DEFAULT BEGIN DATE=DATE CDC FUNDING BEGAN (SITE PARAM).

 +3        IF $GET(DUZ(2))

               SET BWBEGDF=$$TXDT^BWUTL5($PIECE($GET(^BWSITE(DUZ(2),0)),U,17))

 +4       ;

 +5        DO ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,BWBEGDF,"T-30")

 +6        QUIT 

 +7       ;

DEVICE    ;EP

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

 +2        SET ZTRTN="DEQUEUE^BWBRMDE"

 +3        FOR BWSV="BEGDT","ENDDT","HEADER"

               Begin DoDot:1

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

                       SET ZTSAVE("BW"_BWSV)=""

               End DoDot:1

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

 +6        QUIT