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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVUTL2 4697 printed Oct 16, 2024@18:48:39 Page 2
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
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; UTILITY: ZIS, MUMPS XREFS ON NORMAL/ABNORMAL AND ON STATUS.
+4 ;; PROCSCRN-SCREEN ON RESULT/DIAGNOSIS BASED ON PROCEDURE.
+5 ;
+6 ;
ZIS(WVPOP,WVQUE,WVDEF,WVPRMPT,WVMES) ;EP
+1 ;---> CALL TO ^%ZIS
+2 ;---> PARAMETERS:
D ; 1 - WVPOP (RETURNED) WVPOP=1 IF POP=1 (FAIL OR QUIT).
+1 ; 2 - WVQUE=1 (OPTIONAL) SET=1 IF JOB SHOULD WV QUEUEABLE.
+2 ; 3 - WVDEF=DEFAULT (OPTIONAL) IF EXISTS, EQUALS DEFAULT DEVICE.
+3 ; 4 - WVPRMPT (OPTIONAL) IF EXISTS, EQUALS PROMPT.
+4 ; 5 - WVMES (OPTIONAL) A MESSAGE TO DISPLAY IF QUEUED.
+5 ;
+6 ;---> EXAMPLE: D ZIS^WVUTL2(.WVPOP,1,"HOME")
+7 ;
ZIS1 ;EP FOR LOOP BACK FROM FAILED WVQUE.
+1 SET WVPOP=0
+2 ;
+3 ;---> WVPRMPT=WVPRMPT.
+4 SET %ZIS("A")=$SELECT($DATA(WVPRMPT):WVPRMPT,1:" Select DEVICE: ")
+5 ;
+6 ;---> WVDEF=DEFAULT PRINTER.
+7 ;---> IF NO WVDEF, SET WVDEF="P" FOR CLOSEST PRINTER.
+8 Begin DoDot:1
+9 IF '$DATA(WVDEF)
SET %ZIS="P"
QUIT
+10 SET %ZIS("B")=WVDEF
SET %ZIS=""
End DoDot:1
+11 ;
+12 ;---> IF WVQUE=1,JOB MAY BE QUEUED.
+13 IF $GET(WVQUE)]""
IF WVQUE
SET %ZIS=%ZIS_"Q"
+14 ;
+15 WRITE !
DO ^%ZIS
if POP
SET WVPOP=1
+16 ;---> QUIT IF WVPOP (DUOUT OR DTOUT) OR IF NOT WVQUED.
+17 if WVPOP!('$DATA(IO("Q")))
GOTO ZISEXIT
+18 ;
+19 IF IO=IO(0)
WRITE !?5,"Cannot queue to screen or slave printer!",!
GOTO ZIS1
+20 ;
+21 ;---> NEXT LINE: LINE LABEL "ZISQ" ADDED FOR ENTRY WHERE DEVICE
+22 ;---> INFO HAS ALREADY BEEN ASKED AND USER WVQUED OUTPUT.
ZISQ ;EP
+1 ;---> NEXT LINES: JOB WAS QUEUED, THEREFORE SET WVPOP=1 SO THAT THE
+2 ;---> CALLING ROUTINE WILL QUIT (AND LET TASKMAN FINISH THIS JOB).
+3 SET WVPOP=1
+4 IF '$DATA(ZTRTN)
Begin DoDot:1
+5 WRITE !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER."
End DoDot:1
GOTO ZISEXIT
+6 IF '$DATA(ZTDESC)
SET ZTDESC=ZTRTN
+7 SET WVMES=$SELECT($DATA(WVMES):WVMES,1:"W !?5,""Request Queued."",!")
+8 ;
+9 SET ZTIO=$SELECT($DATA(ION):ION,1:"")
+10 IF ZTIO]""
Begin DoDot:1
+11 IF $DATA(IO("DOC"))
SET ZTIO=ZTIO_";"_IOST_";"_IO("DOC")
QUIT
+12 SET ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL
End DoDot:1
+13 SET ZTDTH=$HOROLOG
+14 DO ^%ZTLOAD
DO ^%ZISC
+15 ;---> SET WVPOP=1 TO TELL CALLING ROUTINE TO QUIT (LET TASKMAN FINISH).
+16 SET WVPOP=1
+17 if $DATA(ZTSK)
XECUTE WVMES
HANG 2
+18 ;
ZISEXIT ;EP
+1 KILL WVMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 QUIT
+3 ;
+4 ;
XREFP05 ;EP
+1 ;---> CALLED BY MUMPS "ABNML" XREF ON FIELD .05 IN FILE 790.1.
+2 ;---> REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE, BY DATE
+3 ;---> (PIECE 12), WHEN RESULT/DIAGNOSIS IS "ABNORMAL" (AS STORED IN
+4 ;---> PIECE 21 OF THE POINTED TO WV RESULTS/DIAGNOSIS ENTRY).
+5 ;---> X=IEN WV RESULT/DIAGNOSIS, DA=ENTRY IN WV PROCEDURE FILE.
+6 if '$PIECE(^WV(790.1,DA,0),U,12)
QUIT
+7 IF $PIECE(^WV(790.31,X,0),U,21)
SET ^WV(790.1,"ABNML",$PIECE(^WV(790.1,DA,0),U,12),DA)=""
QUIT
+8 KILL ^WV(790.1,"ABNML",$PIECE(^WV(790.1,DA,0),U,12),DA)
+9 QUIT
+10 ;
XREFP12 ;EP
+1 ;---> CALLED BY MUMPS "ABNML1" XREF ON FIELD .12 IN FILE 790.1.
+2 ;---> LOGIC TO REINDEX RESULTS FIELD .05 IN WV PROCEDURE FILE WHEN
+3 ;---> DATE OF PROCEDURE .12 FIELD IS CHANGED. X=NEWDATE, DA=ENTRY.
+4 ;---> SEE XREFP05 ABOVE.
+5 IF '$PIECE(^WV(790.1,DA,0),U,5)
SET ^WV(790.1,"ABNML",X,DA)=""
QUIT
+6 IF $PIECE(^WV(790.31,$PIECE(^WV(790.1,DA,0),U,5),0),U,21)
SET ^WV(790.1,"ABNML",X,DA)=""
QUIT
+7 KILL ^WV(790.1,"ABNML",X,DA)
+8 QUIT
+9 ;
REXREFN ;EP
+1 ;---> CALLED BY MUMPS XREF ON FIELD .02 IN FILE 790.4.
+2 ;---> LOGIC TO REINDEX STATUS FIELD .14 IN WV NOTIFICATION FILE
+3 ;---> WHEN DATE NOTIFICATION OPENED .02 FIELD IS CHANGED.
+4 ;---> X=NEWDATE, DA=ENTRY.
+5 ;---> NOTE: IF STATUS IS NULL XREF FOR "AOPEN" GETS SET HERE.
+6 IF $PIECE(^WV(790.4,DA,0),U,2)
KILL ^WV(790.4,"AOPEN",$PIECE(^(0),U,2),DA)
+7 IF "o"[$PIECE(^WV(790.4,DA,0),U,14)
SET ^WV(790.4,"AOPEN",X,DA)=""
+8 QUIT
+9 ;
+10 ;
PROCSCRN ;EP
+1 ;---> SCREEN WHEN SELECTING RESULTS/DIAGNOSIS FOR PROCEDURES.
+2 ;---> CALLED BY DIC("S")="D PROCSCRN^WVUTL2" IN SCREEN FOR SEVERAL
+3 ;---> FIELDS IN WV PROCEDURE FILE.
+4 ;---> REQUIRED VARIABLES: WVPN=IEN OF PROCEDURE TYPE
+5 ;---> Y=IEN OF RES/DIAG BEING SCREENED
+6 ;---> EACH LINE MAKES THE RES/DIAG AVAILABLE FOR SELECTION IF:
+7 ;---> 1ST LINE: IF SCREEN VARIABLES ARE UNDEFINED (IE, ALL SELECTABLE).
+8 ;---> 2ND LINE: IF RES/DIAG IS FOR ALL & THIS PROCEDURE IS NOT EXCLUDED
+9 ;---> 3RD LINE: IF A "P" XREF FOR THIS PROCEDURE AND RES/DIAG EXISTS.
+10 ;---> 4TH LINE: OTHERWISE RES/DIAG FAILS SCREEN AND IS NOT SELECTABLE.
+11 if '$DATA(WVPN)!('$DATA(Y))
QUIT
+12 if $PIECE(^WV(790.31,Y,0),U,20)
QUIT
+13 if $DATA(^WV(790.31,"P",WVPN,Y))
QUIT
+14 IF 0
+15 QUIT
+16 ;
PAPSCRN ;EP
+1 ;---> SCREEN CALLED BY FILEMAN ^DD(790.1,.3
+2 ;---> SCREEN WHEN SELECTING THE PAP THAT INITIATED THIS COLPOSCOPY.
+3 ;---> CALLED BY DIC("S")="D PAPSCRN^WVUTL2" IN FIELD .3 OF
+4 ;---> WV PROCEDURE FILE: FIRST CHECK IF THE PROCEDURE IS FOR THIS
+5 ;---> PATIENT, THEN MAKE SURE IT'S A PAP.
+6 if $PIECE(^(0),U,2)=WVDFN&($PIECE(^(0),U,4)=1)
QUIT
+7 IF 0
+8 QUIT
+9 ;
