- 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 Jan 18, 2025@03:49:18 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 ;