Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWUPDISP

BWUPDISP.m

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