BWUPDISP ;IHS/ANMC/MWR - UPLOAD: UNMATCHED REPORTS;15-Feb-2003 22:12;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED" TO DISPLAY AND
;; TRANSFER UNMATCHED LAB REPORTS.
;;
;
UNMATCHP ;EP
;---> CALLED BY OPTION: "BW UPLD PRINT ALL UNMATCHED".
;---> PRINT ALL UNMATCHED LAB RESULTS.
D SETVARS^BWUTL5
D TITLE^BWUTL5("PRINT UNMATCHED LAB RESULTS")
S ZTRTN="UNMATCHQ^BWUPDISP"
D ZIS^BWUTL2(.BWPOP,1)
I BWPOP D EXIT Q
;
UNMATCHQ ;EP
;---> QUEUE PRINT OF UNMATCHED LAB RESULTS STARTS HERE.
D SETVARS^BWUTL5
N N S N=0
F S N=$O(^BWRUN("B",N)) Q:N=""!(BWPOP) D
.S M=0
.F S M=$O(^BWRUN("B",N,M)) Q:M=""!(BWPOP) D
..S BWY=M D DISPLAY1
D ^%ZISC,EXIT
Q
;
EXIT ;EP
D KILLALL^BWUTL8
Q
;
UNMATCH ;EP
;---> CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED".
;---> LOOKUP AND DISPLAY UNMATCHED LAB RESULTS.
D SETVARS^BWUTL5
S (BWPOP1,BWPOP)=0,ZTRTN="DISPLAY1^BWUPDISP"
F Q:BWPOP1 D
.D TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
.W !!," Select the unmatched lab result you wish to display."
.N A S A=" Select ACCESSION# or PATIENT: ",BWPOP=0
.D DIC^BWFMAN(9002086.86,"QEMA",.Y,A)
.I Y<0 S BWPOP1=1 Q
.S (BWY,BWYY)=+Y
.D DEVICE Q:BWPOP
.D DISPLAY1,^%ZISC
.D COPY
D EXIT
Q
;
COPY ;EP
S BWPOP=0
D TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
W !!,"Do you wish to store this report under a Patient's Procedure?"
S DIR(0)="Y",DIR("B")="NO" D HELP1
D ^DIR K DIR W !
Q:$D(DIRUT)!('Y)
W !!,"Select the Patient's Procedure that will receive this report.",!
D LKUPPCD^BWPROC(.Y)
Q:Y<0!($D(DIROUT))
;---> SET BWY=IEN OF PROCEDURE IN PROCEDURE FILE 9002086.1.
S BWY=+Y
D TOP^BWPRPCD(BWY) S BWPOP=0
S BWACC=$P(^BWPCD(BWY,0),U)
D TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
W !!," Do you wish to store this Unmatched Lab Report under the "
W "Procedure",!," just displayed (",BWACC,")?"
W !!?3,"(NOTE: Any data in the Results Text of this Procedure will be"
W !?10,"deleted and then replaced with the Unmatched Lab Report.)",!
S DIR(0)="Y",DIR("B")="NO" D HELP2
D ^DIR K DIR W !
Q:$D(DIRUT)!('Y)
;
;---> PUT UNMATCHED LAB REPORT TEXT INTO LOCAL BW1(N) ARRAY.
S N=0 F S N=$O(^BWRUN(BWYY,1,N)) Q:'N D
.S BW1(N)=^BWRUN(BWYY,1,N,0)
;
;---> TRANSFER REPORT TEXT FROM LOCAL ARRAY INTO SELECTED PROCEDURE.
;---> FIRST PARAMETER="DONE" TELLS BWUPTRAN FORMAT INTO BW1 ARRAY
;---> IS ALREADY DONE (I.E., DON'T CALL FORMAT^BWUPRNI1).
D TRANSFER^BWUPTRAN("DONE",BWY)
;
I BWPOP D Q
.W !!,"The Procedure, ",BWACC,", is being edited by another user."
.W !,"The procedure was not moved out of the Unmatched Reports file."
.D DIRZ^BWUTL3
W !!," The Unmatched Lab Report has now been stored under the"
W " Procedure ",BWACC,"."
S DIK="^BWRUN(",DA=BWYY D ^DIK
W !," The Unmatched Lab Report has been deleted."
W !," The Procedure ",BWACC," now contains the following data:"
D TOP^BWPRPCD(BWY)
Q
;
DELETE ;EP
;---> CALLED BY OPTION: "BW UPLD DELETE UNMATCHED", DELETES UNMATCHED
;---> LAB RESULTS.
;---> CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED".
;---> LOOKUP AND DISPLAY UNMATCHED LAB RESULTS.
D SETVARS^BWUTL5 S BWPOP1=0
F Q:BWPOP1 D
.D TITLE^BWUTL5("DELETE UNMATCHED LAB RESULTS")
.W !!," Select the unmatched lab result you wish to delete."
.N A S A=" Select ACCESSION# or PATIENT: ",BWPOP=0
.D DIC^BWFMAN(9002086.86,"QEMA",.Y,A)
.I Y<0 S BWPOP1=1 Q
.S BWY=+Y
.W !!," Do you wish to display this unmatched result first?"
.S DIR("?")=" Enter YES to display the unmatched result before "
.S DIR("?")=DIR("?")_"deciding to delete it."
.S DIR(0)="Y",DIR("A")=" Enter Yes or No",DIR("B")="NO"
.D ^DIR W !
.I $D(DIRUT) S BWPOP=1 Q
.I Y D DEVICE Q:BWPOP D DISPLAY1,^%ZISC
.W !!," Do you wish to delete this unmatched result now?"
.S DIR("?")=" Enter YES to delete this unmatched result."
.S DIR(0)="Y",DIR("A")=" Enter Yes or No",DIR("B")="NO"
.D ^DIR W !
.I $D(DIRUT) S BWPOP=1 Q
.I Y S DIK="^BWRUN(",DA=BWY D ^DIK W " ...DELETED." D DIRZ^BWUTL3
D EXIT
Q
;
DISPLAY1 ;EP
;---> DISPLAY AN UNMATCHED LAB REPORT.
;---> REQUIRED VARIABLE: BWY=IEN "BW UPLD UNMATCHED LAB REPORTS" FILE.
;---> BWCRT=1 IF OUTPUT IS TO SCREEN.
;
N BWTITLE,DIR,N,X
D SETVARS^BWUTL5
U IO
S BWCRT=$S($E(IOST)="C":1,1:0)
S BWPRMT1=" Press RETURN to continue or '^'to exit, or"
S BWCONFF="*********************** CONFIDENTIAL PATIENT INFORMATION "
S BWCONFF=BWCONFF_"***********************"
S BWTITLE="- UNMATCHED LAB REPORT: -" D CENTERT^BWUTL5(.BWTITLE)
W:BWCRT @IOF
W !,BWCONFF,!!,BWTITLE,!
;
W !,"ACCESSION#: ",$P(^BWRUN(BWY,0),U)
W ?41,"PATIENT: ",$P(^BWRUN(BWY,0),U,3)
S X=$P(^BWRUN(BWY,0),U,2)
W !,"REASON : ",$P($P(^DD(9002086.86,.02,0),X_":",2),";"),! K X
;
W !!?15," ----- TEXT OF LAB RESULT -----",!
S N=0
F S N=$O(^BWRUN(BWY,1,N)) Q:'N!(BWPOP) D
.I $Y+6>IOSL D DIRZ^BWUTL3 Q:BWPOP W @IOF
.W !,^BWRUN(BWY,1,N,0)
D:BWCRT&('BWPOP) DIRZ^BWUTL3 W @IOF
Q
;
DEVICE ;EP
;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
S ZTRTN="DISPLAY1^BWUPDISP"
F BWSV="CRT","Y" D
.I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""
D ZIS^BWUTL2(.BWPOP,1)
Q
;
HELP1 ;EP
;;Answer "YES" to look up and review a Patient's Procedure.
;;You will then be given an opportunity to copy this Unmatched Report
;;into that Procedure.
S BWTAB=5,BWLINL="HELP1" D HELPTX
Q
;
HELP2 ;EP
;;Answer "YES" to if you wish to store this Unmatched Lab Report under
;;the Results Text of the Procedure that was just displayed.
;;
;;Note: In order to avoid confusion, it may help to begin over again
;;and to PRINT both the Unmatched Lab Report and the Procedure; this is
;;done by selecting a printer instead of HOME at the "DEVICE:" prompt.
S BWTAB=5,BWLINL="HELP2" D HELPTX
Q
;
HELPTX ;EP
N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
;
DISPTAB ;EP
;---> CALLED BY OPTION: "BW UPLD LAB DISPLAY ABBREV".
;---> OPTION REMOVED FROM "BW MENU-LAB UPLD TABLS/RESULTS", BUT COULD
;---> BE RECREATED IF NEEDED.
D SETVARS^BWUTL5 N DIC,Y
F Q:BWPOP D
.D TITLE^BWUTL5("DISPLAY LAB RESULTS TABLE ENTRIES")
.W "Select the Abbreviation of the Results Text you wish to display."
.D DIC^BWFMAN(9002086.85,"QEMA",.Y," Select ABBREVIATION: ")
.I Y<0 S BWPOP=1 Q
.S BWY=+Y
.W !!!?3,$P(^BWTFNI(BWY,0),U)
.S N=0
.F S N=$O(^BWTFNI(BWY,1,N)) Q:'N D
..W ?15,^BWTFNI(BWY,1,N,0),!
.D DIRZ^BWUTL3
D EXIT
Q
BWUPDISP ;IHS/ANMC/MWR - UPLOAD: UNMATCHED REPORTS;15-Feb-2003 22:12;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED" TO DISPLAY AND
+4 ;; TRANSFER UNMATCHED LAB REPORTS.
+5 ;;
+6 ;
UNMATCHP ;EP
+1 ;---> CALLED BY OPTION: "BW UPLD PRINT ALL UNMATCHED".
+2 ;---> PRINT ALL UNMATCHED LAB RESULTS.
+3 DO SETVARS^BWUTL5
+4 DO TITLE^BWUTL5("PRINT UNMATCHED LAB RESULTS")
+5 SET ZTRTN="UNMATCHQ^BWUPDISP"
+6 DO ZIS^BWUTL2(.BWPOP,1)
+7 IF BWPOP
DO EXIT
QUIT
+8 ;
UNMATCHQ ;EP
+1 ;---> QUEUE PRINT OF UNMATCHED LAB RESULTS STARTS HERE.
+2 DO SETVARS^BWUTL5
+3 NEW N
SET N=0
+4 FOR
SET N=$ORDER(^BWRUN("B",N))
IF N=""!(BWPOP)
QUIT
Begin DoDot:1
+5 SET M=0
+6 FOR
SET M=$ORDER(^BWRUN("B",N,M))
IF M=""!(BWPOP)
QUIT
Begin DoDot:2
+7 SET BWY=M
DO DISPLAY1
End DoDot:2
End DoDot:1
+8 DO ^%ZISC
DO EXIT
+9 QUIT
+10 ;
EXIT ;EP
+1 DO KILLALL^BWUTL8
+2 QUIT
+3 ;
UNMATCH ;EP
+1 ;---> CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED".
+2 ;---> LOOKUP AND DISPLAY UNMATCHED LAB RESULTS.
+3 DO SETVARS^BWUTL5
+4 SET (BWPOP1,BWPOP)=0
SET ZTRTN="DISPLAY1^BWUPDISP"
+5 FOR
IF BWPOP1
QUIT
Begin DoDot:1
+6 DO TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
+7 WRITE !!," Select the unmatched lab result you wish to display."
+8 NEW A
SET A=" Select ACCESSION# or PATIENT: "
SET BWPOP=0
+9 DO DIC^BWFMAN(9002086.86,"QEMA",.Y,A)
+10 IF Y<0
SET BWPOP1=1
QUIT
+11 SET (BWY,BWYY)=+Y
+12 DO DEVICE
IF BWPOP
QUIT
+13 DO DISPLAY1
DO ^%ZISC
+14 DO COPY
End DoDot:1
+15 DO EXIT
+16 QUIT
+17 ;
COPY ;EP
+1 SET BWPOP=0
+2 DO TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
+3 WRITE !!,"Do you wish to store this report under a Patient's Procedure?"
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO HELP1
+5 DO ^DIR
KILL DIR
WRITE !
+6 IF $DATA(DIRUT)!('Y)
QUIT
+7 WRITE !!,"Select the Patient's Procedure that will receive this report.",!
+8 DO LKUPPCD^BWPROC(.Y)
+9 IF Y<0!($DATA(DIROUT))
QUIT
+10 ;---> SET BWY=IEN OF PROCEDURE IN PROCEDURE FILE 9002086.1.
+11 SET BWY=+Y
+12 DO TOP^BWPRPCD(BWY)
SET BWPOP=0
+13 SET BWACC=$PIECE(^BWPCD(BWY,0),U)
+14 DO TITLE^BWUTL5("DISPLAY UNMATCHED LAB RESULTS")
+15 WRITE !!," Do you wish to store this Unmatched Lab Report under the "
+16 WRITE "Procedure",!," just displayed (",BWACC,")?"
+17 WRITE !!?3,"(NOTE: Any data in the Results Text of this Procedure will be"
+18 WRITE !?10,"deleted and then replaced with the Unmatched Lab Report.)",!
+19 SET DIR(0)="Y"
SET DIR("B")="NO"
DO HELP2
+20 DO ^DIR
KILL DIR
WRITE !
+21 IF $DATA(DIRUT)!('Y)
QUIT
+22 ;
+23 ;---> PUT UNMATCHED LAB REPORT TEXT INTO LOCAL BW1(N) ARRAY.
+24 SET N=0
FOR
SET N=$ORDER(^BWRUN(BWYY,1,N))
IF 'N
QUIT
Begin DoDot:1
+25 SET BW1(N)=^BWRUN(BWYY,1,N,0)
End DoDot:1
+26 ;
+27 ;---> TRANSFER REPORT TEXT FROM LOCAL ARRAY INTO SELECTED PROCEDURE.
+28 ;---> FIRST PARAMETER="DONE" TELLS BWUPTRAN FORMAT INTO BW1 ARRAY
+29 ;---> IS ALREADY DONE (I.E., DON'T CALL FORMAT^BWUPRNI1).
+30 DO TRANSFER^BWUPTRAN("DONE",BWY)
+31 ;
+32 IF BWPOP
Begin DoDot:1
+33 WRITE !!,"The Procedure, ",BWACC,", is being edited by another user."
+34 WRITE !,"The procedure was not moved out of the Unmatched Reports file."
+35 DO DIRZ^BWUTL3
End DoDot:1
QUIT
+36 WRITE !!," The Unmatched Lab Report has now been stored under the"
+37 WRITE " Procedure ",BWACC,"."
+38 SET DIK="^BWRUN("
SET DA=BWYY
DO ^DIK
+39 WRITE !," The Unmatched Lab Report has been deleted."
+40 WRITE !," The Procedure ",BWACC," now contains the following data:"
+41 DO TOP^BWPRPCD(BWY)
+42 QUIT
+43 ;
DELETE ;EP
+1 ;---> CALLED BY OPTION: "BW UPLD DELETE UNMATCHED", DELETES UNMATCHED
+2 ;---> LAB RESULTS.
+3 ;---> CALLED BY OPTION: "BW UPLD DISPLAY UNMATCHED".
+4 ;---> LOOKUP AND DISPLAY UNMATCHED LAB RESULTS.
+5 DO SETVARS^BWUTL5
SET BWPOP1=0
+6 FOR
IF BWPOP1
QUIT
Begin DoDot:1
+7 DO TITLE^BWUTL5("DELETE UNMATCHED LAB RESULTS")
+8 WRITE !!," Select the unmatched lab result you wish to delete."
+9 NEW A
SET A=" Select ACCESSION# or PATIENT: "
SET BWPOP=0
+10 DO DIC^BWFMAN(9002086.86,"QEMA",.Y,A)
+11 IF Y<0
SET BWPOP1=1
QUIT
+12 SET BWY=+Y
+13 WRITE !!," Do you wish to display this unmatched result first?"
+14 SET DIR("?")=" Enter YES to display the unmatched result before "
+15 SET DIR("?")=DIR("?")_"deciding to delete it."
+16 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
SET DIR("B")="NO"
+17 DO ^DIR
WRITE !
+18 IF $DATA(DIRUT)
SET BWPOP=1
QUIT
+19 IF Y
DO DEVICE
IF BWPOP
QUIT
DO DISPLAY1
DO ^%ZISC
+20 WRITE !!," Do you wish to delete this unmatched result now?"
+21 SET DIR("?")=" Enter YES to delete this unmatched result."
+22 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
SET DIR("B")="NO"
+23 DO ^DIR
WRITE !
+24 IF $DATA(DIRUT)
SET BWPOP=1
QUIT
+25 IF Y
SET DIK="^BWRUN("
SET DA=BWY
DO ^DIK
WRITE " ...DELETED."
DO DIRZ^BWUTL3
End DoDot:1
+26 DO EXIT
+27 QUIT
+28 ;
DISPLAY1 ;EP
+1 ;---> DISPLAY AN UNMATCHED LAB REPORT.
+2 ;---> REQUIRED VARIABLE: BWY=IEN "BW UPLD UNMATCHED LAB REPORTS" FILE.
+3 ;---> BWCRT=1 IF OUTPUT IS TO SCREEN.
+4 ;
+5 NEW BWTITLE,DIR,N,X
+6 DO SETVARS^BWUTL5
+7 USE IO
+8 SET BWCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)
+9 SET BWPRMT1=" Press RETURN to continue or '^'to exit, or"
+10 SET BWCONFF="*********************** CONFIDENTIAL PATIENT INFORMATION "
+11 SET BWCONFF=BWCONFF_"***********************"
+12 SET BWTITLE="- UNMATCHED LAB REPORT: -"
DO CENTERT^BWUTL5(.BWTITLE)
+13 IF BWCRT
WRITE @IOF
+14 WRITE !,BWCONFF,!!,BWTITLE,!
+15 ;
+16 WRITE !,"ACCESSION#: ",$PIECE(^BWRUN(BWY,0),U)
+17 WRITE ?41,"PATIENT: ",$PIECE(^BWRUN(BWY,0),U,3)
+18 SET X=$PIECE(^BWRUN(BWY,0),U,2)
+19 WRITE !,"REASON : ",$PIECE($PIECE(^DD(9002086.86,.02,0),X_":",2),";"),!
KILL X
+20 ;
+21 WRITE !!?15," ----- TEXT OF LAB RESULT -----",!
+22 SET N=0
+23 FOR
SET N=$ORDER(^BWRUN(BWY,1,N))
IF 'N!(BWPOP)
QUIT
Begin DoDot:1
+24 IF $Y+6>IOSL
DO DIRZ^BWUTL3
IF BWPOP
QUIT
WRITE @IOF
+25 WRITE !,^BWRUN(BWY,1,N,0)
End DoDot:1
+26 IF BWCRT&('BWPOP)
DO DIRZ^BWUTL3
WRITE @IOF
+27 QUIT
+28 ;
DEVICE ;EP
+1 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
+2 SET ZTRTN="DISPLAY1^BWUPDISP"
+3 FOR BWSV="CRT","Y"
Begin DoDot:1
+4 IF $DATA(@("BW"_BWSV))
SET ZTSAVE("BW"_BWSV)=""
End DoDot:1
+5 DO ZIS^BWUTL2(.BWPOP,1)
+6 QUIT
+7 ;
HELP1 ;EP
+1 ;;Answer "YES" to look up and review a Patient's Procedure.
+2 ;;You will then be given an opportunity to copy this Unmatched Report
+3 ;;into that Procedure.
+4 SET BWTAB=5
SET BWLINL="HELP1"
DO HELPTX
+5 QUIT
+6 ;
HELP2 ;EP
+1 ;;Answer "YES" to if you wish to store this Unmatched Lab Report under
+2 ;;the Results Text of the Procedure that was just displayed.
+3 ;;
+4 ;;Note: In order to avoid confusion, it may help to begin over again
+5 ;;and to PRINT both the Unmatched Lab Report and the Procedure; this is
+6 ;;done by selecting a printer instead of HOME at the "DEVICE:" prompt.
+7 SET BWTAB=5
SET BWLINL="HELP2"
DO HELPTX
+8 QUIT
+9 ;
HELPTX ;EP
+1 NEW I,T,X
SET T=""
FOR I=1:1:BWTAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BWLINL+I)
IF X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
+5 ;
DISPTAB ;EP
+1 ;---> CALLED BY OPTION: "BW UPLD LAB DISPLAY ABBREV".
+2 ;---> OPTION REMOVED FROM "BW MENU-LAB UPLD TABLS/RESULTS", BUT COULD
+3 ;---> BE RECREATED IF NEEDED.
+4 DO SETVARS^BWUTL5
NEW DIC,Y
+5 FOR
IF BWPOP
QUIT
Begin DoDot:1
+6 DO TITLE^BWUTL5("DISPLAY LAB RESULTS TABLE ENTRIES")
+7 WRITE "Select the Abbreviation of the Results Text you wish to display."
+8 DO DIC^BWFMAN(9002086.85,"QEMA",.Y," Select ABBREVIATION: ")
+9 IF Y<0
SET BWPOP=1
QUIT
+10 SET BWY=+Y
+11 WRITE !!!?3,$PIECE(^BWTFNI(BWY,0),U)
+12 SET N=0
+13 FOR
SET N=$ORDER(^BWTFNI(BWY,1,N))
IF 'N
QUIT
Begin DoDot:2
+14 WRITE ?15,^BWTFNI(BWY,1,N,0),!
End DoDot:2
+15 DO DIRZ^BWUTL3
End DoDot:1
+16 DO EXIT
+17 QUIT
