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

BLRDIAG.m

Go to the documentation of this file. 
  1. BLRDIAG ;IHS/ITSC/TPF - MAIN 'SIGN OR SYMPTOM' LAB POV INPUT ROUTINE; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1015,1017,1018,1019,1021,1027,1031,1033,1034**;NOV 01, 1997;Build 88
  1.  ;
  1.  ;NOTE: LRPOVREQ  WAS USED AS A SITE PARAMETER DURING DEVELOPMENT.
  1.  ;IT WAS THOUGHT THAT THIS REQUIREMENT WOULD BE DECIDED UPON BY EACH
  1.  ;SITE. HOWEVER MED REC HAS DECIDED SINCE THIS IS REQUIRED BY LAW IT
  1.  ;SHOULD NOT BE LEFT TO EACH SITE'S CHOICE TO REQUIRE THE FIELD OR
  1.  ;NOT. THE VARIABLE HAS BEEN LEFT IN FOR ALPHA TESTING
  1.  Q
  1. UPPER(X) ; EP
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;
  1.  ;AFTER THE ENTIRE ORDER IS COMPLETE LETS DO THE 'SIGN OR SYMPTOM'
  1.  ;ALSO IF NEED BE CHECK TO SEE IF WE NEED TO ACCESSION THEM AS WELL (FAST E.G.)
  1. COMPORD(LRODT,LRORD) ;EP CALLED FROM LRORDST
  1.  ;
  1.  Q:$G(LRODT)=""!($G(LRORD)="")
  1.  ;
  1.  ;
  1.  N TMPCWL,TMPSET
  1.  D DIAG(LRODT,LRORD)  ;IHS/ITSC/TPF ALLOW ENTRY OF 'SIGN OR SYMPTOM' LAB POV **1015*
  1.  ;
  1.  I LRORDR="" D
  1.  .S ORDIEN="" F  S ORDIEN=$O(^LRO(69,"C",LRORD,LRODT,ORDIEN)) Q:ORDIEN=""  D
  1.  ..;S LRSN=ORDIEN S LRPHSET=0 D ^LRWLST K LRPHSET
  1.  ..;KILL LRNCWL TO MAKE SURE THE PROMPT TO ALLOW USER TO ENTER AN
  1.  ..;NUMBER IS NOT DISPLAYED AT WL2+1^LRWLST
  1.  ..;KILL LRPHSET TO MAKE SURE THE ACCESSION IS DISPLAYED AT
  1.  ..;STWLN+8^LRWLST1
  1.  ..;KILL LRNCWL TO MAKE SURE PROMPT FOR ENTRY # IS NOT ASKED
  1.  ..S LRSN=ORDIEN S:$D(LRNCWL) TMPCWL=$G(LRNCWL) S:$D(LRPHSET) TMPSET=LRPHSET K LRNCWL,LRPHSET D ^LRWLST S:$D(TMPCWL) LRNCWL=TMPCWL S:$D(TMPSET) LRPHSET=TMPSET
  1.  ;
  1.  Q
  1.  ;
  1. DIAG(LRODT,LRORD) ;EP CALLED FROM LROW2A,LRTSTSET
  1.  D ENTRYAUD^BLRUTIL("DIAG^BLRDIAG 0.0")
  1.  ;
  1.  Q:$G(LRODT)=""!($G(LRORD)="")
  1.  ;
  1.  D ENTRYAUD^BLRUTIL("DIAG^BLRDIAG 1.0")
  1.  ;
  1.  ;DO WE HAVE MULTIPLE ENTRIES WE NEED TO ADD THE DIAG TO?
  1.  S MULTIPL=0
  1.  D MULTTST(LRORD,LRODT,.MULTIPL)
  1.  ;
  1.  ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  G:$G(BLRGUI) RPT
  1.  ;----- END IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  ;
  1.  ;IHS/ITSC/TPF 'SIGN OR SYMPTOM' LABPOV **1015**
  1.  D ENTRYAUD^BLRUTIL("DIAG^BLRDIAG 2.0")
  1.  ;
  1.  W !!
  1.  S ASKALL=0  ;IHS/ITSC/TPF ASSUME USER WANTS SAME DIAG FOR ALL TESTS
  1.  I MULTIPL D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .;----- BEGIN IHS/OIT/MKK MODIFICATION LR*5.2*1021 -- Yes or No ONLY
  1. YNONLY . ;
  1.  .;----- END IHS/OIT/MKK MODIFICATION LR*5.2*1021
  1.  .K STUFF
  1.  .K DIR
  1.  .; S DIR("A")="Do you want to enter a different Sign or Symptom for each test?"
  1.  .S DIR("A")="Do you want to enter a different Clinical Indication for each test?"  ; IHS/MSC/MKK - LR*5.2*1034
  1.  .S DIR("B")="N"
  1.  .S DIR(0)="Y"
  1.  .D ^DIR
  1.  .;----- BEGIN IHS/OIT/MKK MODIFICATION LR*5.2*1021 -- Yes or No ONLY
  1.  .I X'="Y"&(X'="N") G YNONLY      ; Only "Y" or "N" allowed
  1.  .;----- END IHS/OIT/MKK MODIFICATION LR*5.2*1021
  1.  .S ASKALL=Y
  1.  ;
  1.  I ASKALL S BLRRLASK=1  ;cmi/anch/maw 5/22/2008 for reference lab
  1.  I ASKALL D ASK(LRORD,LRODT,1,.MULTIPL) W !! Q
  1.  ;
  1.  ;EXECUTION FALLS TO HERE IF A "BLANKET" DIAGNOSIS IS TO BE ENTERED
  1.  ;FOR THE ENTIRE ORDER
  1. RPT ;
  1.  S LRPOVREQ=1
  1.  K DIR,STUFF
  1.  ;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  I $G(BLRGUI) Q:BPCCOM=""  D ASK(LRORD,LRODT,0,.MULTIPL,BPCCOM) Q
  1.  ;----- END IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  ;
  1.  ; S DIR("A",1)="Enter Sign or Symptom for LAB Order number "_LRORD
  1.  ; S DIR("A")="(DO NOT USE 'RULE OUT', 'PROBABLE', 'QUESTIONABLE', etc.)"
  1.  ; S DIR(0)="69.03,9999999.1^^"_$P(^DD(69.03,9999999.1,0),U,5)
  1.  ; W !
  1.  ; D ^DIR
  1.  ; 
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  ; D ASKLPOV("Enter Sign or Symptom for LAB Order number "_LRORD)
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1.  S ^TMP("BLRDIAG",$J,"ORDER")=LRORD
  1.  S ^TMP("BLRDIAG",$J,"ORDER","ALLTESTS")="YES"
  1.  S X=$$ALLTESTS^BLRSGNSY(DFN,LRORD,LRODT)
  1.  D:X GETRID^BLRSGNSP(LRORD)
  1.  Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  I Y[U S LRNOP=0 D CANORD(LRODT,LRORD) W !!,"ORDER CANCELED!!" Q  ;ADDED 12/30/02
  1.  I $G(LRPOVREQ),($D(DUOUT)!$D(DTOUT)!(Y="")) W !,"This is a required response." G RPT
  1.  ; I Y=""!(Y[U) W !!,"No Sign or Symptom entered for order number "_LRORD,!! Q
  1.  I Y=""!(Y[U) W !!,"No Clinical Indication entered for order number "_LRORD,!! Q    ; IHS/MSC/MKK - LR*5.2*1034
  1.  S STUFF=Y
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("B")="YES"
  1.  S DIR("A")="Is this correct"
  1.  D ^DIR
  1.  G:'Y RPT
  1.  ;
  1.  D ASK(LRORD,LRODT,0,.MULTIPL,STUFF)
  1.  W !!
  1.  Q
  1.  ;
  1.  ;DO WE HAVE MULTIPLE TESTS FOR THIS ORDER?
  1. MULTTST(LRORD,LRODT,MULTIPL) ;
  1.  S ^TMP("BLRDIAG",$J,"ORDER")=LRORD
  1.  ;
  1.  S ORDIEN="" F I=1:1 S ORDIEN=$O(^LRO(69,"C",LRORD,LRODT,ORDIEN)) Q:ORDIEN=""  D  Q:MULTIPL
  1.  .I I>1 S MULTIPL=1 Q
  1.  .S TST="" F J=1:1 S TST=$O(^LRO(69,LRODT,1,ORDIEN,2,"B",TST)) Q:TST=""  D  Q:MULTIPL
  1.  ..I J>1 S MULTIPL=1 Q
  1.  Q
  1.  ;
  1.  ;GO THROUGH ORDER D FOR EACH TEST AND PROMPT IF ASKING AND STUFF IF NOT
  1. ASK(LRORD,LRODT,ASK,MULTIPL,STUFF) ; EP
  1.  D ENTRYAUD^BLRUTIL("ASK^BLRDIAG 0.0")
  1.  ;
  1.  N I,J,ORDIEN,TST,SEQ,Y,DFNFLAG
  1.  NEW BAILOUT  ; IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  I +$G(DFN)<1 D
  1.  . S LRSP=$O(^LRO(69,"C",LRORD,LRODT,0))
  1.  . S LRDFN=+$G(^LRO(69,LRODT,1,LRSP,0))
  1.  . S DFN=+$P($G(^LR(LRDFN,0)),"^",3)
  1.  . S DFNFLAG=1
  1.  ;
  1.  S ^TMP("BLRDIAG",$J,"ORDER")=LRORD    ; IHS/MSC/MKK - LR*5.2*1033
  1.  S BAILOUT=0  ; IHS/MSC/MKK - LR*5.2*1033
  1.  S STUFF=$$UPPER($G(STUFF))
  1.  ; S ORDIEN="" F I=1:1 S ORDIEN=$O(^LRO(69,"C",LRORD,LRODT,ORDIEN)) Q:ORDIEN=""  D
  1.  ; S ORDIEN=""  F  S ORDIEN=$O(^LRO(69,"C",LRORD,LRODT,ORDIEN)) Q:ORDIEN=""  D    ; IHS/OIT/MKK - LR*5.2*1031
  1.  S ORDIEN=""  F  S ORDIEN=$O(^LRO(69,"C",LRORD,LRODT,ORDIEN)) Q:ORDIEN=""!(BAILOUT)  D    ; IHS/MSC/MKK - LR*5.2*1033
  1.  .; S TST="" F J=1:1 S TST=$O(^LRO(69,LRODT,1,ORDIEN,2,"B",TST)) Q:TST=""  D
  1.  .; S TST=""  F  S TST=$O(^LRO(69,LRODT,1,ORDIEN,2,"B",TST)) Q:TST=""  D          ; IHS/OIT/MKK - LR*5.2*1031
  1.  .S TST=0  F  S TST=$O(^LRO(69,LRODT,1,ORDIEN,2,TST)) Q:TST<1!(BAILOUT)  D          ; IHS/MSC/MKK - LR*5.2*1033
  1.  .. ;
  1.  .. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1.  .. W !!,?4,"SIGN/SYMPTOM FOR TEST: ",$$GET1^DIQ(69.03,TST_","_ORDIEN_","_LRODT_",","TEST/PROCEDURE")
  1.  .. S BAILOUT=$$GETSDIAG^BLRSGNSY(DFN,LRORD,LRODT,ORDIEN,TST)
  1.  .. Q
  1.  .. ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  .. ;
  1.  ..S DA=$O(^LRO(69,LRODT,1,ORDIEN,2,"B",TST,""))
  1.  ..S DIE="^LRO(69,"_LRODT_",1,"_ORDIEN_",2,"
  1.  ..I ASK D  Q
  1.  ...S DEF=$G(^LRO(69,LRODT,1,ORDIEN,2,DA,9999999))
  1.  ...D ASK1(.STUFF,TST,DEF,ORDIEN,DA)
  1.  ...Q:$G(Y)[U  ;IF TRUE TEST HAS BEEN CANCELLED
  1.  ...S DR="9999999.1///^S X=STUFF"
  1.  ...;----- BEGIN IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  ...; L +^LRO(69,LRODT,1,ORDIEN):1 I '$T W !,"ORDER IS CURRENTLY BEING EDITED!" Q
  1.  ...L +^LRO(69,LRODT,1,ORDIEN):1 I '$T W:'$G(BLRGUI) !,"ORDER IS CURRENTLY BEING EDITED!" S:$G(BLRGUI) RESULT(1)=-1,RESULT(2)="ORDER IS CURRENTLY BEING EDITED!"  Q
  1.  ...;----- END IHS MODIFICATIONS LR*5.2*1019 -- Patient Chart Mod
  1.  ...D ^DIE L -^LRO(69,LRODT,1,ORDIEN)
  1.  ..I 'ASK,($G(STUFF)'="") S DR="9999999.1///^S X=STUFF" D
  1.  ...L +^LRO(69,LRODT,1,ORDIEN):1 I '$T W !,"ORDER IS CURRENTLY BEING EDITED!" Q
  1.  ...D ^DIE L -^LRO(69,LRODT,1,ORDIEN)
  1.  ;
  1.  K:+$G(DFNFLAG) LRDFN,DFN,LRSP
  1.  K I,J,ORDIEN,TST
  1.  K ^TMP("BLRDIAG",$J,"ORDER")     ; IHS/MSC/MKK - LR*5.2*1033
  1.  Q
  1.  ;
  1.  ;PROMPT FOR 'SIGN OR SYMPTOM'
  1. ASK1(STUFF,TST,DEF,ORDIEN,DA) ;
  1.  S LRPOVREQ=1
  1. ASK1B K DIR
  1.  S STUFF=$$UPPER($G(STUFF))
  1.  ; S DIR("B")=$G(DEF)
  1.  ; S DIR("A",1)="Enter Sign or Symptom for "_$P($G(^LAB(60,TST,0)),U)
  1.  ; S DIR("A")="(DO NOT USE 'RULE OUT', 'PROBABLE', 'QUESTIONABLE', etc.)"
  1.  ; S DIR(0)="69.03,9999999.1^^"_$P(^DD(69.03,9999999.1,0),U,5)
  1.  ; W !
  1.  ; D ^DIR
  1.  ; 
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  ; D ASKLPOV("Enter Sign or Symptom for "_$P($G(^LAB(60,TST,0)),U))
  1.  D ASKLPOV("Enter Clinical Indication for "_$P($G(^LAB(60,TST,0)),U))     ; IHS/MSC/MKK - LR*5.2*1034
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  ;I Y[U S LRNOP=0 D CANTST(ORDIEN,$S($G(DA)'="":DA,1:LRTN)) W !!,"TEST CANCELED FROM ORDER!!" Q  ;ADDED 12/30/02
  1.  I Y[U S LRNOP=0 D CANTST(ORDIEN,$S($G(DA)'="":DA,$D(LRSN):LRSN,1:LRTN)) W !!,"TEST CANCELED FROM ORDER!!" Q  ;IHS/ITSC/TPF 7/1/03 **1017** 
  1.  I $G(LRPOVREQ),($D(DUOUT)!$D(DTOUT)!(Y="")) W !,"This is a required response." G ASK1B
  1.  ; I Y=""!(Y[U) W !!,"No Sign or Symptom entered for "_$P($G(^LAB(60,TST,0)),U),!! Q
  1.  I Y=""!(Y[U) W !!,"No Clinical Indication entered for "_$P($G(^LAB(60,TST,0)),U),!! Q   ; IHS/MSC/MKK - LR*5.2*1034
  1.  S STUFF=Y
  1. ASK2 K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("B")="YES"
  1.  S DIR("A")="Is this correct"
  1.  D ^DIR
  1.  G:'Y ASK1B
  1.  Q
  1.  ;
  1.  ;ENTER DIAGNOSIS FOR JUST ONE TEST
  1. ADDTST(LRODT,ORDIEN,TST) ;EP CALLED FROM LRTSTSET WHEN ADDING TEST TO ORDER
  1.  Q:$G(LRODT)=""!($G(ORDIEN)="")!($G(TST)="")
  1.  ;
  1.  Q:$$CHKORDAC^BLRSGNSU(LRODT,ORDIEN,TST)    ; IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  NEW BAILOUT
  1.  ;
  1.  S DA=$O(^LRO(69,LRODT,1,ORDIEN,2,"B",TST,""))
  1.  S DIE="^LRO(69,"_LRODT_",1,"_ORDIEN_",2,"
  1.  ; D ASK1(.STUFF,TST,,ORDIEN,DA)
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1.  S:+$G(LRORD)<1 LRORD=+$G(^LRO(69,LRODT,1,ORDIEN,.1))
  1.  S ^TMP("BLRDIAG",$J,"ORDER")=LRORD
  1.  S ^TMP("BLRDIAG",$J,"ORDER","ADDTST")=DA
  1.  S X=$$GETSDIAG^BLRSGNSY(DFN,LRORD,LRODT,ORDIEN,DA,.BAILOUT)
  1.  K ^TMP("BLRDIAG",$J,"ORDER")
  1.  K:+$G(BAILOUT) LRFLG Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  Q:$G(Y)[U&($G(XQY0)["LRADD TO ORDER")  ;IF TRUE THEN ORDER CANCELED
  1.  ;
  1.  I $G(Y)[U,($G(XQY0)["LRADD TO ACC") D DELACC Q
  1.  S DR="9999999.1///^S X=STUFF"
  1.  L +^LRO(69,LRODT,1,ORDIEN):1 I '$T W !,"ORDER IS CURRENTLY BEING EDITED!" Q
  1.  D ^DIE                              ; IHS/MSC/MKK - LR*5.2*1033 -- routine BLRSGNSY adds Diag to File 69
  1.  L -^LRO(69,LRODT,1,ORDIEN)
  1.  Q
  1.  ;
  1.  ;CANCEL ENTIRE ORDER
  1. CANORD(LRODT,LRORD) ;EP
  1.  S LRSNTMP="" F  S LRSNTMP=$O(^LRO(69,"C",LRORD,LRODT,LRSNTMP)) Q:LRSNTMP=""  D
  1.  .S TT=0 F  S TT=$O(^LRO(69,LRODT,1,LRSNTMP,2,TT)) Q:TT<1  K TST S X=^(TT,0) I '$P(X,"^",11) I 'LRNOP D
  1.  ..S X=^LRO(69,LRODT,1,LRSNTMP,2,TT,0) W !,?5,$P(^LAB(60,+X,0),"^")
  1.  ..S $P(^LRO(69,LRODT,1,LRSNTMP,2,TT,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^L^"_DUZ
  1.  ..; S DIE="^LRO(69,LRODT,1,LRSNTMP,2,",DA=TT,DA(1)=LRSN,DA(2)=LRODT,DR=99 D ^DIE    ;NO NEED TO ENTER COMMENTS?
  1.  S LRNCWL=1  ;SET TO BYPASS PRINTING ORDER COPY
  1.  ;S LRPHSET=1  ;
  1.  K LRSNTMP
  1.  Q
  1.  ;
  1.  ;CANCEL TEST
  1. CANTST(LRSN,TT) ;EP
  1.  S LRACC=0
  1.  K TST
  1.  S X=^LRO(69,LRODT,1,LRSN,2,TT,0)
  1.  I '$P(X,"^",11) S TST(+X)="",LRAD=+$P(X,U,3),LRAA=+$P(X,U,4),LRAN=+$P(X,U,5),ORIFN=$P(X,U,7) I 'LRNOP D
  1.  .S X=^LRO(69,LRODT,1,LRSN,2,TT,0) W !,?5,$P(^LAB(60,+X,0),"^")
  1.  .S $P(^LRO(69,LRODT,1,LRSN,2,TT,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^L^"_DUZ
  1.  .;S DIE="^LRO(69,LRODT,1,LRSN,2,",DA=TT,DA(1)=LRSN,DA(2)=LRODT,DR=99 D ^DIE    ;NO NEED TO ENTER COMMENTS?
  1.  ;S LRNCWL=1  ;SET TO BYPASS PRINTING ORDER COPY
  1.  ;S LRPHSET=1
  1.  Q
  1.  ;
  1.  ;DELETE ACCESSION
  1.  ;THIS IS CALLED WHEN THEN OPTION ADD A TEST TO AN ACCESSION IS USED
  1.  ;AND THE USER USES THE "^" TO GET OUT OF THE 'SIGN OR SYMPTOM' PROMPT
  1.  ;IF THIS IS NOT DONE THE USER CAN THEN RESULT THE TEST WITHOUT HAVING
  1.  ;TO ENTER A POV
  1. DELACC ;
  1.  S LRTSTS=LRTS
  1.  S LRTNM=$P($G(^LAB(60,LRTS,0)),U)
  1.  ;S LRCCOM="UP ARROWED OUT OF 'SIGN OR SYMPTOM' PROMPT"
  1.  S LRCCOM="CANCELLED NO POV ENTERED"
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRIDT=$P(^(3),U,5)
  1.  S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LROWDT=$P(X,U,3),LRODT=$P(X,U,4),LRSN=$P(X,U,5) I LROWDT=LRAD S:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,9)) LROWDT=^(9)
  1.  D TESTDEL^BLRDIAG1
  1.  ; W !!,"Press Return to continue..." R X:DTIME
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  W !!
  1.  D ^XBFMK
  1.  S DIR(0)="FAO"
  1.  S DIR("A")="Press Return to continue..."
  1.  S DIR("T")=15
  1.  D ^DIR
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  K LRFLG
  1.  ;
  1.  Q
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1. ASKLPOV(PROMPT) ; EP - Ask Lab Purpose Of Visit. Must be answered.
  1.  NEW ANSWER,BADINPUT,DA,DIE
  1.  ;
  1.  S BADINPUT=1
  1.  F  Q:+$G(BADINPUT)<1  D
  1.  . D ^XBFMK
  1.  . K DIR
  1.  . S DIR("A",1)=PROMPT
  1.  . S DIR("A")="(DO NOT USE 'RULE OUT', 'PROBABLE', 'QUESTIONABLE', etc.)"
  1.  . S DIR(0)="69.03,9999999.1^^"_$P(^DD(69.03,9999999.1,0),U,5)
  1.  . W !
  1.  . D ^DIR
  1.  . S BADINPUT=0
  1.  . S ANSWER=$$UP^XLFSTR($P(Y,"^"))
  1.  . I +$G(DIRUT)>0!(ANSWER["RULE OUT")!(ANSWER["PROBABLE")!(ANSWER["QUESTIONABLE") D
  1.  .. W !,?4,"Invalid/'^' input not allowed."
  1.  .. D PRESSKEY^BLRGMENU(9)
  1.  .. S BADINPUT=1
  1.  Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031