125 lines
4.5 KiB
Mathematica
125 lines
4.5 KiB
Mathematica
WVUTL2 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: ZIS, XREF, PROSCREEN; ;9/1/98 11:37
|
|
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|
;; UTILITY: ZIS, MUMPS XREFS ON NORMAL/ABNORMAL AND ON STATUS.
|
|
;; PROCSCRN-SCREEN ON RESULT/DIAGNOSIS BASED ON PROCEDURE.
|
|
;
|
|
;
|
|
ZIS(WVPOP,WVQUE,WVDEF,WVPRMPT,WVMES) ;EP
|
|
;---> CALL TO ^%ZIS
|
|
;---> PARAMETERS:
|
|
D ; 1 - WVPOP (RETURNED) WVPOP=1 IF POP=1 (FAIL OR QUIT).
|
|
; 2 - WVQUE=1 (OPTIONAL) SET=1 IF JOB SHOULD WV QUEUEABLE.
|
|
; 3 - WVDEF=DEFAULT (OPTIONAL) IF EXISTS, EQUALS DEFAULT DEVICE.
|
|
; 4 - WVPRMPT (OPTIONAL) IF EXISTS, EQUALS PROMPT.
|
|
; 5 - WVMES (OPTIONAL) A MESSAGE TO DISPLAY IF QUEUED.
|
|
;
|
|
;---> EXAMPLE: D ZIS^WVUTL2(.WVPOP,1,"HOME")
|
|
;
|
|
ZIS1 ;EP FOR LOOP BACK FROM FAILED WVQUE.
|
|
S WVPOP=0
|
|
;
|
|
;---> WVPRMPT=WVPRMPT.
|
|
S %ZIS("A")=$S($D(WVPRMPT):WVPRMPT,1:" Select DEVICE: ")
|
|
;
|
|
;---> WVDEF=DEFAULT PRINTER.
|
|
;---> IF NO WVDEF, SET WVDEF="P" FOR CLOSEST PRINTER.
|
|
D
|
|
.I '$D(WVDEF) S %ZIS="P" Q
|
|
.S %ZIS("B")=WVDEF,%ZIS=""
|
|
;
|
|
;---> IF WVQUE=1,JOB MAY BE QUEUED.
|
|
I $G(WVQUE)]"" I WVQUE S %ZIS=%ZIS_"Q"
|
|
;
|
|
W ! D ^%ZIS S:POP WVPOP=1
|
|
;---> QUIT IF WVPOP (DUOUT OR DTOUT) OR IF NOT WVQUED.
|
|
G:WVPOP!('$D(IO("Q"))) ZISEXIT
|
|
;
|
|
I IO=IO(0) W !?5,"Cannot queue to screen or slave printer!",! G ZIS1
|
|
;
|
|
;---> NEXT LINE: LINE LABEL "ZISQ" ADDED FOR ENTRY WHERE DEVICE
|
|
;---> INFO HAS ALREADY BEEN ASKED AND USER WVQUED OUTPUT.
|
|
ZISQ ;EP
|
|
;---> NEXT LINES: JOB WAS QUEUED, THEREFORE SET WVPOP=1 SO THAT THE
|
|
;---> CALLING ROUTINE WILL QUIT (AND LET TASKMAN FINISH THIS JOB).
|
|
S WVPOP=1
|
|
I '$D(ZTRTN) D G ZISEXIT
|
|
.W !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER."
|
|
I '$D(ZTDESC) S ZTDESC=ZTRTN
|
|
S WVMES=$S($D(WVMES):WVMES,1:"W !?5,""Request Queued."",!")
|
|
;
|
|
S ZTIO=$S($D(ION):ION,1:"")
|
|
I ZTIO]"" D
|
|
.I $D(IO("DOC")) S ZTIO=ZTIO_";"_IOST_";"_IO("DOC") Q
|
|
.S ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL
|
|
S ZTDTH=$H
|
|
D ^%ZTLOAD,^%ZISC
|
|
;---> SET WVPOP=1 TO TELL CALLING ROUTINE TO QUIT (LET TASKMAN FINISH).
|
|
S WVPOP=1
|
|
X:$D(ZTSK) WVMES H 2
|
|
;
|
|
ZISEXIT ;EP
|
|
K WVMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|
Q
|
|
;
|
|
;
|
|
XREFP05 ;EP
|
|
;---> CALLED BY MUMPS "ABNML" XREF ON FIELD .05 IN FILE 790.1.
|
|
;---> REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE, BY DATE
|
|
;---> (PIECE 12), WHEN RESULT/DIAGNOSIS IS "ABNORMAL" (AS STORED IN
|
|
;---> PIECE 21 OF THE POINTED TO WV RESULTS/DIAGNOSIS ENTRY).
|
|
;---> X=IEN WV RESULT/DIAGNOSIS, DA=ENTRY IN WV PROCEDURE FILE.
|
|
Q:'$P(^WV(790.1,DA,0),U,12)
|
|
I $P(^WV(790.31,X,0),U,21) S ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)="" Q
|
|
K ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)
|
|
Q
|
|
;
|
|
XREFP12 ;EP
|
|
;---> CALLED BY MUMPS "ABNML1" XREF ON FIELD .12 IN FILE 790.1.
|
|
;---> LOGIC TO REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE WHEN
|
|
;---> DATE OF PROCEDURE .12 FIELD IS CHANGED. X=NEWDATE, DA=ENTRY.
|
|
;---> SEE XREFP05 ABOVE.
|
|
I '$P(^WV(790.1,DA,0),U,5) S ^WV(790.1,"ABNML",X,DA)="" Q
|
|
I $P(^WV(790.31,$P(^WV(790.1,DA,0),U,5),0),U,21) S ^WV(790.1,"ABNML",X,DA)="" Q
|
|
K ^WV(790.1,"ABNML",X,DA)
|
|
Q
|
|
;
|
|
REXREFN ;EP
|
|
;---> CALLED BY MUMPS XREF ON FIELD .02 IN FILE 790.4.
|
|
;---> LOGIC TO REINDEX STATUS FIELD .14 IN WV NOTIFICATION FILE
|
|
;---> WHEN DATE NOTIFICATION OPENED .02 FIELD IS CHANGED.
|
|
;---> X=NEWDATE, DA=ENTRY.
|
|
;---> NOTE: IF STATUS IS NULL XREF FOR "AOPEN" GETS SET HERE.
|
|
I $P(^WV(790.4,DA,0),U,2) K ^WV(790.4,"AOPEN",$P(^(0),U,2),DA)
|
|
I "o"[$P(^WV(790.4,DA,0),U,14) S ^WV(790.4,"AOPEN",X,DA)=""
|
|
Q
|
|
;
|
|
;
|
|
PROCSCRN ;EP
|
|
;---> SCREEN WHEN SELECTING RESULTS/DIAGNOSIS FOR PROCEDURES.
|
|
;---> CALLED BY DIC("S")="D PROCSCRN^WVUTL2" IN SCREEN FOR SEVERAL
|
|
;---> FIELDS IN WV PROCEDURE FILE.
|
|
;---> REQUIRED VARIABLES: WVPN=IEN OF PROCEDURE TYPE
|
|
;---> Y=IEN OF RES/DIAG BEING SCREENED
|
|
;---> EACH LINE MAKES THE RES/DIAG AVAILABLE FOR SELECTION IF:
|
|
;---> 1ST LINE: IF SCREEN VARIABLES ARE UNDEFINED (IE, ALL SELECTABLE).
|
|
;---> 2ND LINE: IF RES/DIAG IS FOR ALL & THIS PROCEDURE IS NOT EXCLUDED
|
|
;---> 3RD LINE: IF A "P" XREF FOR THIS PROCEDURE AND RES/DIAG EXISTS.
|
|
;---> 4TH LINE: OTHERWISE RES/DIAG FAILS SCREEN AND IS NOT SELECTABLE.
|
|
Q:'$D(WVPN)!('$D(Y))
|
|
Q:$P(^WV(790.31,Y,0),U,20)
|
|
Q:$D(^WV(790.31,"P",WVPN,Y))
|
|
I 0
|
|
Q
|
|
;
|
|
PAPSCRN ;EP
|
|
;---> SCREEN CALLED BY FILEMAN ^DD(790.1,.3
|
|
;---> SCREEN WHEN SELECTING THE PAP THAT INITIATED THIS COLPOSCOPY.
|
|
;---> CALLED BY DIC("S")="D PAPSCRN^WVUTL2" IN FIELD .3 OF
|
|
;---> WV PROCEDURE FILE: FIRST CHECK IF THE PROCEDURE IS FOR THIS
|
|
;---> PATIENT, THEN MAKE SURE IT'S A PAP.
|
|
Q:$P(^(0),U,2)=WVDFN&($P(^(0),U,4)=1)
|
|
I 0
|
|
Q
|
|
;
|