- 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
