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

BWUTL2.m

Go to the documentation of this file. 
  1. BWUTL2 ;IHS/ANMC/MWR - UTIL: ZIS, XREF, PROSCREEN;17-Apr-2003 12:02;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  UTILITY: ZIS, MUMPS XREFS ON NORMAL/ABNORMAL AND ON STATUS.
  1.  ;;  PROCSCRN-SCREEN ON RESULT/DIAGNOSIS BASED ON PROCEDURE.
  1.  ;
  1.  ;
  1. ZIS(BWPOP,BWQUE,BWDEF,BWPRMPT,BWMES) ;EP
  1.  ;---> CALL TO ^%ZIS
  1.  ;---> PARAMETERS:
  1.  ;     1 - BWPOP         (RETURNED) BWPOP=1 IF POP=1 (FAIL OR QUIT).
  1.  ;     2 - BWQUE=1       (OPTIONAL) SET=1 IF JOB SHOULD BW QUEUEABLE.
  1.  ;     3 - BWDEF=DEFAULT (OPTIONAL) IF EXISTS, EQUALS DEFAULT DEVICE.
  1.  ;     4 - BWPRMPT       (OPTIONAL) IF EXISTS, EQUALS PROMPT.
  1.  ;     5 - BWMES         (OPTIONAL) A MESSAGE TO DISPLAY IF QUEUED.
  1.  ;
  1.  ;---> EXAMPLE: D ZIS^BWUTL2(.BWPOP,1,"HOME")
  1.  ;
  1. ZIS1 ;EP FOR LOOP BACK FROM FAILED BWQUE.
  1.  S BWPOP=0
  1.  ;
  1.  ;---> BWPRMPT=BWPRMPT.
  1.  S %ZIS("A")=$S($D(BWPRMPT):BWPRMPT,1:"   Select DEVICE: ")
  1.  ;
  1.  ;---> BWDEF=DEFAULT PRINTER.
  1.  ;---> IF NO BWDEF, SET BWDEF="P" FOR CLOSEST PRINTER.
  1.  D
  1.  .I '$D(BWDEF) S %ZIS="P" Q
  1.  .S %ZIS("B")=BWDEF,%ZIS=""
  1.  ;
  1.  ;---> IF BWQUE=1,JOB MAY BE QUEUED.
  1.  I $G(BWQUE)]"" I BWQUE S %ZIS=%ZIS_"Q"
  1.  ;
  1.  W ! D ^%ZIS S:POP BWPOP=1
  1.  ;---> QUIT IF BWPOP (DUOUT OR DTOUT) OR IF NOT BWQUED.
  1.  G:BWPOP!('$D(IO("Q"))) ZISEXIT
  1.  ;
  1.  I IO=IO(0) W !?5,"Cannot queue to screen or slave printer!",! G ZIS1
  1.  ;
  1.  ;---> NEXT LINE: LINE LABEL "ZISQ" ADDED FOR ENTRY WHERE DEVICE
  1.  ;---> INFO HAS ALREADY BEEN ASKED AND USER BWQUED OUTPUT.
  1. ZISQ ;EP
  1.  ;---> NEXT LINES: JOB WAS QUEUED, THEREFORE SET BWPOP=1 SO THAT THE
  1.  ;---> CALLING ROUTINE WILL QUIT (AND LET TASKMAN FINISH THIS JOB).
  1.  S BWPOP=1
  1.  I '$D(ZTRTN) D  G ZISEXIT
  1.  .W !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER."
  1.  I '$D(ZTDESC) S ZTDESC=ZTRTN
  1.  S BWMES=$S($D(BWMES):BWMES,1:"W !?5,""Request Queued."",!")
  1.  ;
  1.  S ZTIO=$S($D(ION):ION,1:"")
  1.  I ZTIO]"" D
  1.  .I $D(IO("DOC")) S ZTIO=ZTIO_";"_IOST_";"_IO("DOC") Q
  1.  .S ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL
  1.  D ^%ZTLOAD,^%ZISC
  1.  ;---> SET BWPOP=1 TO TELL CALLING ROUTINE TO QUIT (LET TASKMAN FINISH).
  1.  S BWPOP=1
  1.  X:$D(ZTSK) BWMES H 2
  1.  ;
  1. ZISEXIT ;EP
  1.  K BWMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1.  ;
  1. XREFP05 ;EP
  1.  ;---> CALLED BY MUMPS "ABNML" XREF ON FIELD .05 IN FILE 9002086.1.
  1.  ;---> REINDEX RESULTS FIELD .05 IN BW PROCEDURE FILE, BY DATE
  1.  ;---> (PIECE 12), WHEN RESULT/DIAGNOSIS IS "ABNORMAL" (AS STORED IN
  1.  ;---> PIECE 21 OF THE POINTED TO BW RESULTS/DIAGNOSIS ENTRY).
  1.  ;---> X=IEN BW RESULT/DIAGNOSIS, DA=ENTRY IN BW PROCEDURE FILE.
  1.  Q:'$P(^BWPCD(DA,0),U,12)
  1.  I $P(^BWDIAG(X,0),U,21) S ^BWPCD("ABNML",$P(^BWPCD(DA,0),U,12),DA)="" Q
  1.  K ^BWPCD("ABNML",$P(^BWPCD(DA,0),U,12),DA)
  1.  Q
  1.  ;
  1. XREFP12 ;EP
  1.  ;---> CALLED BY MUMPS "ABNML1" XREF ON FIELD .12 IN FILE 9002086.1.
  1.  ;---> LOGIC TO REINDEX RESULTS FIELD .05 IN BW PROCEDURE FILE WHEN
  1.  ;---> DATE OF PROCEDURE .12 FIELD IS CHANGED.  X=NEWDATE, DA=ENTRY.
  1.  ;---> SEE XREFP05 ABOVE.
  1.  I '$P(^BWPCD(DA,0),U,5) S ^BWPCD("ABNML",X,DA)="" Q
  1.  I $P(^BWDIAG($P(^BWPCD(DA,0),U,5),0),U,21) S ^BWPCD("ABNML",X,DA)="" Q
  1.  K ^BWPCD("ABNML",X,DA)
  1.  Q
  1.  ;
  1. REXREFN ;EP
  1.  ;---> CALLED BY MUMPS XREF ON FIELD .02 IN FILE 9002086.4.
  1.  ;---> LOGIC TO REINDEX STATUS FIELD .14 IN BW NOTIFICATION FILE
  1.  ;---> WHEN DATE NOTIFICATION OPENED .02 FIELD IS CHANGED.
  1.  ;---> X=NEWDATE, DA=ENTRY.
  1.  ;---> NOTE: IF STATUS IS NULL XREF FOR "AOPEN" GETS SET HERE.
  1.  I $P(^BWNOT(DA,0),U,2) K ^BWNOT("AOPEN",$P(^(0),U,2),DA)
  1.  I "o"[$P(^BWNOT(DA,0),U,14) S ^BWNOT("AOPEN",X,DA)=""
  1.  Q
  1.  ;
  1.  ;
  1. PROCSCRN ;EP
  1.  ;---> SCREEN WHEN SELECTING RESULTS/DIAGNOSIS FOR PROCEDURES.
  1.  ;---> CALLED BY DIC("S")="D PROCSCRN^BWUTL2" IN SCREEN FOR SEVERAL
  1.  ;---> FIELDS IN BW PROCEDURE FILE.
  1.  ;---> REQUIRED VARIABLES: BWPN=IEN OF PROCEDURE TYPE
  1.  ;--->                        Y=IEN OF RES/DIAG BEING SCREENED
  1.  ;---> EACH LINE MAKES THE RES/DIAG AVAILABLE FOR SELECTION IF:
  1.  ;---> 1ST LINE: IF SCREEN VARIABLES ARE UNDEFINED (IE, ALL SELECTABLE).
  1.  ;---> 2ND LINE: IF RES/DIAG IS FOR ALL & THIS PROCEDURE IS NOT EXCLUDED
  1.  ;---> 3RD LINE: IF A "P" XREF FOR THIS PROCEDURE AND RES/DIAG EXISTS.
  1.  ;---> 4TH LINE: OTHERWISE RES/DIAG FAILS SCREEN AND IS NOT SELECTABLE.
  1.  Q:'$D(BWPN)!('$D(Y))
  1.  Q:$P(^BWDIAG(Y,0),U,20)
  1.  Q:$D(^BWDIAG("P",BWPN,Y))
  1.  I 0
  1.  Q
  1.  ;
  1. PAPSCRN ;EP
  1.  ;---> SCREEN CALLED BY FILEMAN ^DD.
  1.  ;---> SCREEN WHEN SELECTING THE PAP THAT INITIATED THIS COLPOSCOPY.
  1.  ;---> CALLED BY DIC("S")="D PAPSCRN^BWUTL2" IN FIELD .3 OF
  1.  ;---> BW PROCEDURE FILE: FIRST CHECK IF THE PROCEDURE IS FOR THIS
  1.  ;---> PATIENT, THEN MAKE SURE IT'S A PAP.
  1.  Q:$P(^(0),U,2)=+$G(BWDFN)&($P(^(0),U,4)=1)
  1.  I 0
  1.  Q
  1.  ;
  1. ERRCD(X,W,Y) ;EP
  1.  ;---> DISPLAY ERROR CODE FROM BW ERROR CODE FILE.
  1.  ;---> REQUIRED VARIABLE: X=IEN OF ERROR CODE.
  1.  ;---> OPTIONAL VARIABLE: W=1 IF TEXT SHOULD NOT BE WRITTEN OUT.
  1.  ;---> RETURNED VARIABLE: Y=TEXT OF ERROR CODE.
  1.  ;
  1.  S:$G(W)'=1 W=0
  1.  I '+$G(X) D ERRW() Q
  1.  I '$D(^BWERR(X,0)) D  Q
  1.  .S Y="Error Code does not exist in BW ERROR CODE File." D:'W ERRW(Y)
  1.  S Y=$P(^BWERR(X,0),U,2) D:'W ERRW(Y)
  1.  Q
  1.  ;
  1. ERRW(X) ;EP
  1.  ;---> WRITE OUT ERROR CODE.
  1.  W !!?5,"Data for this Procedure was NOT passed to PCC because:"
  1.  I $G(X)']"" W !?5,"NO ERROR CODE PROVIDED.",! Q
  1.  W !?5,X,! D DIRZ^BWUTL3
  1.  Q