source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL2.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1WVUTL2 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: ZIS, XREF, PROSCREEN; ;9/1/98 11:37
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; UTILITY: ZIS, MUMPS XREFS ON NORMAL/ABNORMAL AND ON STATUS.
5 ;; PROCSCRN-SCREEN ON RESULT/DIAGNOSIS BASED ON PROCEDURE.
6 ;
7 ;
8ZIS(WVPOP,WVQUE,WVDEF,WVPRMPT,WVMES) ;EP
9 ;---> CALL TO ^%ZIS
10 ;---> PARAMETERS:
11D ; 1 - WVPOP (RETURNED) WVPOP=1 IF POP=1 (FAIL OR QUIT).
12 ; 2 - WVQUE=1 (OPTIONAL) SET=1 IF JOB SHOULD WV QUEUEABLE.
13 ; 3 - WVDEF=DEFAULT (OPTIONAL) IF EXISTS, EQUALS DEFAULT DEVICE.
14 ; 4 - WVPRMPT (OPTIONAL) IF EXISTS, EQUALS PROMPT.
15 ; 5 - WVMES (OPTIONAL) A MESSAGE TO DISPLAY IF QUEUED.
16 ;
17 ;---> EXAMPLE: D ZIS^WVUTL2(.WVPOP,1,"HOME")
18 ;
19ZIS1 ;EP FOR LOOP BACK FROM FAILED WVQUE.
20 S WVPOP=0
21 ;
22 ;---> WVPRMPT=WVPRMPT.
23 S %ZIS("A")=$S($D(WVPRMPT):WVPRMPT,1:" Select DEVICE: ")
24 ;
25 ;---> WVDEF=DEFAULT PRINTER.
26 ;---> IF NO WVDEF, SET WVDEF="P" FOR CLOSEST PRINTER.
27 D
28 .I '$D(WVDEF) S %ZIS="P" Q
29 .S %ZIS("B")=WVDEF,%ZIS=""
30 ;
31 ;---> IF WVQUE=1,JOB MAY BE QUEUED.
32 I $G(WVQUE)]"" I WVQUE S %ZIS=%ZIS_"Q"
33 ;
34 W ! D ^%ZIS S:POP WVPOP=1
35 ;---> QUIT IF WVPOP (DUOUT OR DTOUT) OR IF NOT WVQUED.
36 G:WVPOP!('$D(IO("Q"))) ZISEXIT
37 ;
38 I IO=IO(0) W !?5,"Cannot queue to screen or slave printer!",! G ZIS1
39 ;
40 ;---> NEXT LINE: LINE LABEL "ZISQ" ADDED FOR ENTRY WHERE DEVICE
41 ;---> INFO HAS ALREADY BEEN ASKED AND USER WVQUED OUTPUT.
42ZISQ ;EP
43 ;---> NEXT LINES: JOB WAS QUEUED, THEREFORE SET WVPOP=1 SO THAT THE
44 ;---> CALLING ROUTINE WILL QUIT (AND LET TASKMAN FINISH THIS JOB).
45 S WVPOP=1
46 I '$D(ZTRTN) D G ZISEXIT
47 .W !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER."
48 I '$D(ZTDESC) S ZTDESC=ZTRTN
49 S WVMES=$S($D(WVMES):WVMES,1:"W !?5,""Request Queued."",!")
50 ;
51 S ZTIO=$S($D(ION):ION,1:"")
52 I ZTIO]"" D
53 .I $D(IO("DOC")) S ZTIO=ZTIO_";"_IOST_";"_IO("DOC") Q
54 .S ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL
55 S ZTDTH=$H
56 D ^%ZTLOAD,^%ZISC
57 ;---> SET WVPOP=1 TO TELL CALLING ROUTINE TO QUIT (LET TASKMAN FINISH).
58 S WVPOP=1
59 X:$D(ZTSK) WVMES H 2
60 ;
61ZISEXIT ;EP
62 K WVMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
63 Q
64 ;
65 ;
66XREFP05 ;EP
67 ;---> CALLED BY MUMPS "ABNML" XREF ON FIELD .05 IN FILE 790.1.
68 ;---> REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE, BY DATE
69 ;---> (PIECE 12), WHEN RESULT/DIAGNOSIS IS "ABNORMAL" (AS STORED IN
70 ;---> PIECE 21 OF THE POINTED TO WV RESULTS/DIAGNOSIS ENTRY).
71 ;---> X=IEN WV RESULT/DIAGNOSIS, DA=ENTRY IN WV PROCEDURE FILE.
72 Q:'$P(^WV(790.1,DA,0),U,12)
73 I $P(^WV(790.31,X,0),U,21) S ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)="" Q
74 K ^WV(790.1,"ABNML",$P(^WV(790.1,DA,0),U,12),DA)
75 Q
76 ;
77XREFP12 ;EP
78 ;---> CALLED BY MUMPS "ABNML1" XREF ON FIELD .12 IN FILE 790.1.
79 ;---> LOGIC TO REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE WHEN
80 ;---> DATE OF PROCEDURE .12 FIELD IS CHANGED. X=NEWDATE, DA=ENTRY.
81 ;---> SEE XREFP05 ABOVE.
82 I '$P(^WV(790.1,DA,0),U,5) S ^WV(790.1,"ABNML",X,DA)="" Q
83 I $P(^WV(790.31,$P(^WV(790.1,DA,0),U,5),0),U,21) S ^WV(790.1,"ABNML",X,DA)="" Q
84 K ^WV(790.1,"ABNML",X,DA)
85 Q
86 ;
87REXREFN ;EP
88 ;---> CALLED BY MUMPS XREF ON FIELD .02 IN FILE 790.4.
89 ;---> LOGIC TO REINDEX STATUS FIELD .14 IN WV NOTIFICATION FILE
90 ;---> WHEN DATE NOTIFICATION OPENED .02 FIELD IS CHANGED.
91 ;---> X=NEWDATE, DA=ENTRY.
92 ;---> NOTE: IF STATUS IS NULL XREF FOR "AOPEN" GETS SET HERE.
93 I $P(^WV(790.4,DA,0),U,2) K ^WV(790.4,"AOPEN",$P(^(0),U,2),DA)
94 I "o"[$P(^WV(790.4,DA,0),U,14) S ^WV(790.4,"AOPEN",X,DA)=""
95 Q
96 ;
97 ;
98PROCSCRN ;EP
99 ;---> SCREEN WHEN SELECTING RESULTS/DIAGNOSIS FOR PROCEDURES.
100 ;---> CALLED BY DIC("S")="D PROCSCRN^WVUTL2" IN SCREEN FOR SEVERAL
101 ;---> FIELDS IN WV PROCEDURE FILE.
102 ;---> REQUIRED VARIABLES: WVPN=IEN OF PROCEDURE TYPE
103 ;---> Y=IEN OF RES/DIAG BEING SCREENED
104 ;---> EACH LINE MAKES THE RES/DIAG AVAILABLE FOR SELECTION IF:
105 ;---> 1ST LINE: IF SCREEN VARIABLES ARE UNDEFINED (IE, ALL SELECTABLE).
106 ;---> 2ND LINE: IF RES/DIAG IS FOR ALL & THIS PROCEDURE IS NOT EXCLUDED
107 ;---> 3RD LINE: IF A "P" XREF FOR THIS PROCEDURE AND RES/DIAG EXISTS.
108 ;---> 4TH LINE: OTHERWISE RES/DIAG FAILS SCREEN AND IS NOT SELECTABLE.
109 Q:'$D(WVPN)!('$D(Y))
110 Q:$P(^WV(790.31,Y,0),U,20)
111 Q:$D(^WV(790.31,"P",WVPN,Y))
112 I 0
113 Q
114 ;
115PAPSCRN ;EP
116 ;---> SCREEN CALLED BY FILEMAN ^DD(790.1,.3
117 ;---> SCREEN WHEN SELECTING THE PAP THAT INITIATED THIS COLPOSCOPY.
118 ;---> CALLED BY DIC("S")="D PAPSCRN^WVUTL2" IN FIELD .3 OF
119 ;---> WV PROCEDURE FILE: FIRST CHECK IF THE PROCEDURE IS FOR THIS
120 ;---> PATIENT, THEN MAKE SURE IT'S A PAP.
121 Q:$P(^(0),U,2)=WVDFN&($P(^(0),U,4)=1)
122 I 0
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.