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

WVUTL2.m

Go to the documentation of this file.
  1. WVUTL2 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: ZIS, XREF, PROSCREEN; ;9/1/98 11:37
  1. ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
  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(WVPOP,WVQUE,WVDEF,WVPRMPT,WVMES) ;EP
  1. ;---> CALL TO ^%ZIS
  1. ;---> PARAMETERS:
  1. D ; 1 - WVPOP (RETURNED) WVPOP=1 IF POP=1 (FAIL OR QUIT).
  1. ; 2 - WVQUE=1 (OPTIONAL) SET=1 IF JOB SHOULD WV QUEUEABLE.
  1. ; 3 - WVDEF=DEFAULT (OPTIONAL) IF EXISTS, EQUALS DEFAULT DEVICE.
  1. ; 4 - WVPRMPT (OPTIONAL) IF EXISTS, EQUALS PROMPT.
  1. ; 5 - WVMES (OPTIONAL) A MESSAGE TO DISPLAY IF QUEUED.
  1. ;
  1. ;---> EXAMPLE: D ZIS^WVUTL2(.WVPOP,1,"HOME")
  1. ;
  1. ZIS1 ;EP FOR LOOP BACK FROM FAILED WVQUE.
  1. S WVPOP=0
  1. ;
  1. ;---> WVPRMPT=WVPRMPT.
  1. S %ZIS("A")=$S($D(WVPRMPT):WVPRMPT,1:" Select DEVICE: ")
  1. ;
  1. ;---> WVDEF=DEFAULT PRINTER.
  1. ;---> IF NO WVDEF, SET WVDEF="P" FOR CLOSEST PRINTER.
  1. D
  1. .I '$D(WVDEF) S %ZIS="P" Q
  1. .S %ZIS("B")=WVDEF,%ZIS=""
  1. ;
  1. ;---> IF WVQUE=1,JOB MAY BE QUEUED.
  1. I $G(WVQUE)]"" I WVQUE S %ZIS=%ZIS_"Q"
  1. ;
  1. W ! D ^%ZIS S:POP WVPOP=1
  1. ;---> QUIT IF WVPOP (DUOUT OR DTOUT) OR IF NOT WVQUED.
  1. G:WVPOP!('$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 WVQUED OUTPUT.
  1. ZISQ ;EP
  1. ;---> NEXT LINES: JOB WAS QUEUED, THEREFORE SET WVPOP=1 SO THAT THE
  1. ;---> CALLING ROUTINE WILL QUIT (AND LET TASKMAN FINISH THIS JOB).
  1. S WVPOP=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 WVMES=$S($D(WVMES):WVMES,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. S ZTDTH=$H
  1. D ^%ZTLOAD,^%ZISC
  1. ;---> SET WVPOP=1 TO TELL CALLING ROUTINE TO QUIT (LET TASKMAN FINISH).
  1. S WVPOP=1
  1. X:$D(ZTSK) WVMES H 2
  1. ;
  1. ZISEXIT ;EP
  1. K WVMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. ;
  1. XREFP05 ;EP
  1. ;---> CALLED BY MUMPS "ABNML" XREF ON FIELD .05 IN FILE 790.1.
  1. ;---> REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE, BY DATE
  1. ;---> (PIECE 12), WHEN RESULT/DIAGNOSIS IS "ABNORMAL" (AS STORED IN
  1. ;---> PIECE 21 OF THE POINTED TO WV RESULTS/DIAGNOSIS ENTRY).
  1. ;---> X=IEN WV RESULT/DIAGNOSIS, DA=ENTRY IN WV PROCEDURE FILE.
  1. Q:'$P(^WV(790.1,DA,0),U,12)
  1. I $P(^WV(790.31,X,0),U,21) S ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)="" Q
  1. K ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)
  1. Q
  1. ;
  1. XREFP12 ;EP
  1. ;---> CALLED BY MUMPS "ABNML1" XREF ON FIELD .12 IN FILE 790.1.
  1. ;---> LOGIC TO REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE WHEN
  1. ;---> DATE OF PROCEDURE .12 FIELD IS CHANGED. X=NEWDATE, DA=ENTRY.
  1. ;---> SEE XREFP05 ABOVE.
  1. I '$P(^WV(790.1,DA,0),U,5) S ^WV(790.1,"ABNML",X,DA)="" Q
  1. I $P(^WV(790.31,$P(^WV(790.1,DA,0),U,5),0),U,21) S ^WV(790.1,"ABNML",X,DA)="" Q
  1. K ^WV(790.1,"ABNML",X,DA)
  1. Q
  1. ;
  1. REXREFN ;EP
  1. ;---> CALLED BY MUMPS XREF ON FIELD .02 IN FILE 790.4.
  1. ;---> LOGIC TO REINDEX STATUS FIELD .14 IN WV 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(^WV(790.4,DA,0),U,2) K ^WV(790.4,"AOPEN",$P(^(0),U,2),DA)
  1. I "o"[$P(^WV(790.4,DA,0),U,14) S ^WV(790.4,"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^WVUTL2" IN SCREEN FOR SEVERAL
  1. ;---> FIELDS IN WV PROCEDURE FILE.
  1. ;---> REQUIRED VARIABLES: WVPN=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(WVPN)!('$D(Y))
  1. Q:$P(^WV(790.31,Y,0),U,20)
  1. Q:$D(^WV(790.31,"P",WVPN,Y))
  1. I 0
  1. Q
  1. ;
  1. PAPSCRN ;EP
  1. ;---> SCREEN CALLED BY FILEMAN ^DD(790.1,.3
  1. ;---> SCREEN WHEN SELECTING THE PAP THAT INITIATED THIS COLPOSCOPY.
  1. ;---> CALLED BY DIC("S")="D PAPSCRN^WVUTL2" IN FIELD .3 OF
  1. ;---> WV 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)=WVDFN&($P(^(0),U,4)=1)
  1. I 0
  1. Q
  1. ;