- ORCDGMRC ;SLC/MKB-Utility functions for GMRC dialogs ;Nov 20, 2023@08:56:08
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,68,100,181,361,608**;Dec 17, 1997;Build 15
- ; External References
- ; Reference to ^DIC supported by ICR 10006
- ; Reference to ^DIR supported by ICR 10026
- ; Reference to SERV1^GMRCASV supported by ICR 2426
- ; Reference to GETDEF^GMRCDRFR supported by ICR 3119
- ; Reference to GETSVC^GMRCPR0 supported by ICR 2982
- ; Reference to $$PROVDX and PREREQ^GMRCUTL1 supported by ICR 3121
- ; Reference to CONFIG^LEXSET supported by ICR 1609
- ; Reference to $$RJ and $$UP^XLFSTR supported by ICR 10104
- ; Reference to DISP^XQORM1 supported by ICR 10102
- ; Reference to $$STATCHK^ICDAPIU supported by ICR 3991
- CID ;--validates date and enforces any associated parameters
- ;called from GMRCOR CONSULT, Clinically Indicated Date POST-SELECTION ACTION
- Q:$G(ORTYPE)'="Z"
- I $G(ORDIALOG(PROMPT,INST))'["T" K DONE W $C(7),!,"Response must be relative date (e.g. TODAY, T+7D, T+3M)"
- N X,Y,%DT,FUTDAYS,FUTDATE S X=$G(ORDIALOG(PROMPT,INST)),%DT="X" I $L(X) D ^%DT S:Y>0 ORDATE=$P(Y,".")
- S FUTDAYS=$$GET^XPAR("PKG","ORCDGMRC FUTURE DATE LIMIT",1,"I") S:$G(FUTDAYS)>0 FUTDATE=$$FMADD^XLFDT(DT,FUTDAYS)
- I ORDATE>FUTDATE K DONE W $C(7),!,"Response cannot be more than "_FUTDAYS_" days in the future."
- Q
- URGENCY(TYPE) ; -- Returns index of allowable urgencies from file #101.42
- N X S X=$S($$VAL^ORCD("CATEGORY")'="I":"O",TYPE="C":"T",1:"R")
- S ORDIALOG(PROMPT,"D")="S.GMRC"_X
- Q
- ;
- PLACE ; -- Returns list of allowable places of consultation
- Q:$D(ORDIALOG(PROMPT,"LIST")) N CHOICES,I,J,INPT,X
- S INPT=($$VAL^ORCD("CATEGORY")="I")
- I INPT S CHOICES="B^Bedside;C^Consultant's Choice"
- I 'INPT S CHOICES="E^Emergency Room;C^Consultant's Choice"
- S I=0 F J=1:1:$L(CHOICES,";") S X=$P(CHOICES,";",J) D
- . S I=I+1,ORDIALOG(PROMPT,"LIST",I)=X
- . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR($P(X,U,2)))=$P(X,U)
- S ORDIALOG(PROMPT,"LIST")=I_"^1"
- Q
- ;
- CHANGED(PRMT) ; -- Kill lists for Request Service or Place of Consultation
- N I,P
- S I=$S(PRMT="OI":"REQUEST SERVICE",1:"PLACE OF CONSULTATION")
- S P=$$PTR^ORCD("OR GTX "_I) Q:'P
- K ORDIALOG(P,"LIST"),ORDIALOG(P,1)
- Q
- ;
- GETSERV ; -- Get list of orderable services
- N GMRCTO,GMRCDG,I,X K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
- S (GMRCTO,GMRCDG)=1 D SERV1^GMRCASV ; get list of orderable services
- F I=1:1 S X=+$G(^TMP("GMRCSLIST",$J,I)) Q:X'>0 S $P(^TMP("GMRCS",$J,X),U,2)=I
- Q
- ;
- LISTSERV(ORI) ; -- List Consult services from ORSERV
- N ORSTK,ORCNT,ORX,ORQ
- W !,"Choose from:" S:$G(ORI)'>0 ORI=1
- S (ORSTK,ORQ)=0,ORCNT=1,ORSTK(0)=$P(^TMP("GMRCSLIST",$J,ORI),U,3)
- F S ORX=$G(^TMP("GMRCSLIST",$J,ORI)) Q:ORX="" D Q:ORQ S ORI=ORI+1
- . I $P(ORX,U,3)'=+$G(ORSTK(ORSTK)) D POP I ORSTK'>0 S ORQ=1 Q
- . S ORCNT=ORCNT+1 I ORCNT>(IOSL-6) S:'$$CONT ORQ=1 Q:$G(ORQ) S ORCNT=1
- . W !,?((ORSTK*2)),$P(ORX,U,2)
- . W:$P(ORX,U,5) " ("_$S($P(ORX,U,5)=1:"Grouper",1:"Tracking")_" Only)"
- . I $P(ORX,U,4)="+" S ORSTK=ORSTK+1,ORSTK(ORSTK)=+ORX
- Q
- ;
- POP ; -- pop stack
- S ORSTK=ORSTK-1 Q:ORSTK'>0
- I ORSTK(ORSTK)'=$P(ORX,U,3) G POP
- Q
- ;
- CONT() ; -- continue?
- N X,Y,DIR S DIR(0)="E" D ^DIR
- Q +Y
- ;
- CKSERV ; -- Ck service usage in Post-Selection Action
- N GMRCI,ORI
- S GMRCI=+$P(^ORD(101.43,+Y,0),U,2)
- S ORI=+$P($G(^TMP("GMRCS",$J,GMRCI)),U,2) S:ORI'>0 ORI=1
- I $P($G(^TMP("GMRCSLIST",$J,ORI)),U,5)=1 D LISTSERV^ORCDGMRC(ORI) K DONE
- Q
- ;
- PROCSVC ; -- Get list of services for procedure
- Q:$D(ORDIALOG(PROMPT,"LIST")) Q:'$L($T(GETSVC^GMRCPR0))
- N OI,PROTCL,ORY,ORI,X
- S OI=+$$VAL^ORCD("PROCEDURE"),PROTCL=$P($G(^ORD(101.43,OI,0)),U,2) ;ID
- D:PROTCL GETSVC^GMRCPR0(.ORY,PROTCL)
- I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!" H 1 S ORQUIT=1 Q
- M ORDIALOG(PROMPT,"LIST")=ORY S $P(ORDIALOG(PROMPT,"LIST"),U,2)=1
- S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 S X=$P(ORY(ORI),U,2),ORDIALOG(PROMPT,"LIST","B",X)=+ORY(ORI)
- Q
- ;
- CKPROCSV ; -- Make sure procedure has at least one service
- N PROT,ORY S PROT=$P($G(^ORD(101.43,+Y,0)),U,2)
- D GETSVC^GMRCPR0(.ORY,PROT) I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!",! K DONE
- Q
- ;
- NWHELP ; -- help code for NW action
- N X
- W !!,"Select the type of request you wish to enter, either a consult to a service",!,"or a procedure that may be ordered without a formal consult."
- W !!,"Press <return> to continue ..." R X:DTIME
- S X="?" D DISP^XQORM1 W !
- Q
- ;
- REASON ; -- Get default Reason for Request text for Service
- N ORIT,ORSERV,OROOT
- S ORIT=$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
- S ORSERV=$P($G(^ORD(101.43,+ORIT,0)),U,2) Q:'ORSERV!(ORSERV["99PRO")
- S OROOT=$NA(^TMP("ORWORD",$J,PROMPT,INST)) D
- . N PROMPT,INST,X,Y,DIR,ACTION,REQD,MULT,ITEM,COND ;protect var's
- . D GETDEF^GMRCDRFR(OROOT,ORSERV,+$G(ORVP),$S($G(ORVP):1,1:0))
- S:$D(^TMP("ORWORD",$J,PROMPT,INST)) Y=OROOT
- Q
- ;
- ENPDX ; -- setup Prov Dx field
- N CODE
- S ORPDX=$$PROVDX^GMRCUTL1($S($D(ORPROC):ORPROC,1:$G(ORSERV)))
- S CODE=$$PTR^ORCD("OR GTX CODE")
- I $P(ORPDX,U)="S" K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST) S COND="I 0" Q
- S:$G(ORTYPE)'="Z" REQD=$S($P(ORPDX,U)="R":1,1:0)
- K:$P(ORPDX,U,2)'="L" ORDIALOG(CODE,INST)
- I $P(ORPDX,U,2)="L" S ORDIALOG(PROMPT,"?")="Select a preliminary diagnosis from the Lexicon, as text or an ICD code." K:'$L($G(ORDIALOG(CODE,INST))) ORDIALOG(PROMPT,INST)
- I $L($G(ORDIALOG(CODE,INST))),'$$STATCHK^ICDXCODE("DIAGNOSIS",ORDIALOG(CODE,INST),DT) D ;csv
- . D EN^DDIOL("The existing diagnosis is associated with an inactive ICD-9 code.")
- . I $G(REQD) D EN^DDIOL("Another code must be selected before proceeding.")
- . I '$G(REQD) D EN^DDIOL("If another code is not selected, no code will be saved with the new order.")
- . D EN^DDIOL(" ")
- . K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST)
- . S ACTION=$G(ACTION)_"W"
- Q
- ;
- LEX ; -- search Lexicon for Prov Dx
- I $L($G(ORESET)),ORESET=Y Q ;no change
- I Y?1." " K DONE W !!,$C(7),"Use of only spaces not allowed!",! Q
- Q:$P(ORPDX,U,2)'="L" ;free text only, no ICD code
- N DIC,DUOUT,DTOUT,ORCS
- S ORCS="ICD"
- I DT>=$$IMPDATE^LEXU("10D") S ORCS="10D"
- D CONFIG^LEXSET(ORCS,ORCS,DT)
- S DIC="^LEX(757.01,",DIC(0)="EQM",DIC("A")="Provisional Diagnosis: "
- S:$L($G(ORESET)) DIC("B")=ORESET
- D ^DIC I Y'>0 D Q
- . I $L($G(ORESET)) S ORDIALOG(PROMPT,ORI)=ORESET
- . E K ORDIALOG(PROMPT,ORI)
- . I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
- . I REQD,'$D(ORDIALOG(PROMPT,ORI)) K DONE W !!,$C(7),$$REQUIRED^ORCDLG1,!
- S ORDIALOG(PROMPT,ORI)=$P(Y,U,2)
- I ORCS="ICD" S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(1)) K Y(1)
- I ORCS="10D" S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(30)) K Y(30)
- Q
- ;
- SERVMSG ; -- Get, display text message for service ORSERV
- Q:'$G(ORSERV)&('$G(ORPROC)) Q:'FIRST ;show first time only
- N ORTXT,I,CNT,HDR S HDR=$S($G(ORMENU):5,1:7)
- D PREREQ^GMRCUTL1("ORTXT",$S($D(ORPROC):ORPROC,1:ORSERV),+ORVP)
- Q:'$D(ORTXT)
- I $D(ORPROC) W !!,$$RJ^XLFSTR("** Procedure Pre-requisite **",57)
- E W !!,$$RJ^XLFSTR("** Consult Service Pre-requisite **",57)
- S (I,CNT)=0 F S I=$O(ORTXT(I)) Q:I'>0 D Q:$G(ORQUIT)
- . S CNT=CNT+1 I CNT>(IOSL-HDR) S CNT=0 I '$$CONT S ORQUIT=1 Q
- . W !,ORTXT(I,0)
- Q:$G(ORQUIT) S:'$$CONT ORQUIT=1 W !
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDGMRC 7305 printed Feb 18, 2025@23:54:33 Page 2
- ORCDGMRC ;SLC/MKB-Utility functions for GMRC dialogs ;Nov 20, 2023@08:56:08
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,68,100,181,361,608**;Dec 17, 1997;Build 15
- +2 ; External References
- +3 ; Reference to ^DIC supported by ICR 10006
- +4 ; Reference to ^DIR supported by ICR 10026
- +5 ; Reference to SERV1^GMRCASV supported by ICR 2426
- +6 ; Reference to GETDEF^GMRCDRFR supported by ICR 3119
- +7 ; Reference to GETSVC^GMRCPR0 supported by ICR 2982
- +8 ; Reference to $$PROVDX and PREREQ^GMRCUTL1 supported by ICR 3121
- +9 ; Reference to CONFIG^LEXSET supported by ICR 1609
- +10 ; Reference to $$RJ and $$UP^XLFSTR supported by ICR 10104
- +11 ; Reference to DISP^XQORM1 supported by ICR 10102
- +12 ; Reference to $$STATCHK^ICDAPIU supported by ICR 3991
- CID ;--validates date and enforces any associated parameters
- +1 ;called from GMRCOR CONSULT, Clinically Indicated Date POST-SELECTION ACTION
- +2 if $GET(ORTYPE)'="Z"
- QUIT
- +3 IF $GET(ORDIALOG(PROMPT,INST))'["T"
- KILL DONE
- WRITE $CHAR(7),!,"Response must be relative date (e.g. TODAY, T+7D, T+3M)"
- +4 NEW X,Y,%DT,FUTDAYS,FUTDATE
- SET X=$GET(ORDIALOG(PROMPT,INST))
- SET %DT="X"
- IF $LENGTH(X)
- DO ^%DT
- if Y>0
- SET ORDATE=$PIECE(Y,".")
- +5 SET FUTDAYS=$$GET^XPAR("PKG","ORCDGMRC FUTURE DATE LIMIT",1,"I")
- if $GET(FUTDAYS)>0
- SET FUTDATE=$$FMADD^XLFDT(DT,FUTDAYS)
- +6 IF ORDATE>FUTDATE
- KILL DONE
- WRITE $CHAR(7),!,"Response cannot be more than "_FUTDAYS_" days in the future."
- +7 QUIT
- URGENCY(TYPE) ; -- Returns index of allowable urgencies from file #101.42
- +1 NEW X
- SET X=$SELECT($$VAL^ORCD("CATEGORY")'="I":"O",TYPE="C":"T",1:"R")
- +2 SET ORDIALOG(PROMPT,"D")="S.GMRC"_X
- +3 QUIT
- +4 ;
- PLACE ; -- Returns list of allowable places of consultation
- +1 if $DATA(ORDIALOG(PROMPT,"LIST"))
- QUIT
- NEW CHOICES,I,J,INPT,X
- +2 SET INPT=($$VAL^ORCD("CATEGORY")="I")
- +3 IF INPT
- SET CHOICES="B^Bedside;C^Consultant's Choice"
- +4 IF 'INPT
- SET CHOICES="E^Emergency Room;C^Consultant's Choice"
- +5 SET I=0
- FOR J=1:1:$LENGTH(CHOICES,";")
- SET X=$PIECE(CHOICES,";",J)
- Begin DoDot:1
- +6 SET I=I+1
- SET ORDIALOG(PROMPT,"LIST",I)=X
- +7 SET ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR($PIECE(X,U,2)))=$PIECE(X,U)
- End DoDot:1
- +8 SET ORDIALOG(PROMPT,"LIST")=I_"^1"
- +9 QUIT
- +10 ;
- CHANGED(PRMT) ; -- Kill lists for Request Service or Place of Consultation
- +1 NEW I,P
- +2 SET I=$SELECT(PRMT="OI":"REQUEST SERVICE",1:"PLACE OF CONSULTATION")
- +3 SET P=$$PTR^ORCD("OR GTX "_I)
- if 'P
- QUIT
- +4 KILL ORDIALOG(P,"LIST"),ORDIALOG(P,1)
- +5 QUIT
- +6 ;
- GETSERV ; -- Get list of orderable services
- +1 NEW GMRCTO,GMRCDG,I,X
- KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB)
- +2 ; get list of orderable services
- SET (GMRCTO,GMRCDG)=1
- DO SERV1^GMRCASV
- +3 FOR I=1:1
- SET X=+$GET(^TMP("GMRCSLIST",$JOB,I))
- if X'>0
- QUIT
- SET $PIECE(^TMP("GMRCS",$JOB,X),U,2)=I
- +4 QUIT
- +5 ;
- LISTSERV(ORI) ; -- List Consult services from ORSERV
- +1 NEW ORSTK,ORCNT,ORX,ORQ
- +2 WRITE !,"Choose from:"
- if $GET(ORI)'>0
- SET ORI=1
- +3 SET (ORSTK,ORQ)=0
- SET ORCNT=1
- SET ORSTK(0)=$PIECE(^TMP("GMRCSLIST",$JOB,ORI),U,3)
- +4 FOR
- SET ORX=$GET(^TMP("GMRCSLIST",$JOB,ORI))
- if ORX=""
- QUIT
- Begin DoDot:1
- +5 IF $PIECE(ORX,U,3)'=+$GET(ORSTK(ORSTK))
- DO POP
- IF ORSTK'>0
- SET ORQ=1
- QUIT
- +6 SET ORCNT=ORCNT+1
- IF ORCNT>(IOSL-6)
- if '$$CONT
- SET ORQ=1
- if $GET(ORQ)
- QUIT
- SET ORCNT=1
- +7 WRITE !,?((ORSTK*2)),$PIECE(ORX,U,2)
- +8 if $PIECE(ORX,U,5)
- WRITE " ("_$SELECT($PIECE(ORX,U,5)=1:"Grouper",1:"Tracking")_" Only)"
- +9 IF $PIECE(ORX,U,4)="+"
- SET ORSTK=ORSTK+1
- SET ORSTK(ORSTK)=+ORX
- End DoDot:1
- if ORQ
- QUIT
- SET ORI=ORI+1
- +10 QUIT
- +11 ;
- POP ; -- pop stack
- +1 SET ORSTK=ORSTK-1
- if ORSTK'>0
- QUIT
- +2 IF ORSTK(ORSTK)'=$PIECE(ORX,U,3)
- GOTO POP
- +3 QUIT
- +4 ;
- CONT() ; -- continue?
- +1 NEW X,Y,DIR
- SET DIR(0)="E"
- DO ^DIR
- +2 QUIT +Y
- +3 ;
- CKSERV ; -- Ck service usage in Post-Selection Action
- +1 NEW GMRCI,ORI
- +2 SET GMRCI=+$PIECE(^ORD(101.43,+Y,0),U,2)
- +3 SET ORI=+$PIECE($GET(^TMP("GMRCS",$JOB,GMRCI)),U,2)
- if ORI'>0
- SET ORI=1
- +4 IF $PIECE($GET(^TMP("GMRCSLIST",$JOB,ORI)),U,5)=1
- DO LISTSERV^ORCDGMRC(ORI)
- KILL DONE
- +5 QUIT
- +6 ;
- PROCSVC ; -- Get list of services for procedure
- +1 if $DATA(ORDIALOG(PROMPT,"LIST"))
- QUIT
- if '$LENGTH($TEXT(GETSVC^GMRCPR0))
- QUIT
- +2 NEW OI,PROTCL,ORY,ORI,X
- +3 ;ID
- SET OI=+$$VAL^ORCD("PROCEDURE")
- SET PROTCL=$PIECE($GET(^ORD(101.43,OI,0)),U,2)
- +4 if PROTCL
- DO GETSVC^GMRCPR0(.ORY,PROTCL)
- +5 IF $GET(ORY)'>0
- WRITE $CHAR(7),!,"There are no services defined for this procedure!"
- HANG 1
- SET ORQUIT=1
- QUIT
- +6 MERGE ORDIALOG(PROMPT,"LIST")=ORY
- SET $PIECE(ORDIALOG(PROMPT,"LIST"),U,2)=1
- +7 SET ORI=0
- FOR
- SET ORI=$ORDER(ORY(ORI))
- if ORI'>0
- QUIT
- SET X=$PIECE(ORY(ORI),U,2)
- SET ORDIALOG(PROMPT,"LIST","B",X)=+ORY(ORI)
- +8 QUIT
- +9 ;
- CKPROCSV ; -- Make sure procedure has at least one service
- +1 NEW PROT,ORY
- SET PROT=$PIECE($GET(^ORD(101.43,+Y,0)),U,2)
- +2 DO GETSVC^GMRCPR0(.ORY,PROT)
- IF $GET(ORY)'>0
- WRITE $CHAR(7),!,"There are no services defined for this procedure!",!
- KILL DONE
- +3 QUIT
- +4 ;
- NWHELP ; -- help code for NW action
- +1 NEW X
- +2 WRITE !!,"Select the type of request you wish to enter, either a consult to a service",!,"or a procedure that may be ordered without a formal consult."
- +3 WRITE !!,"Press <return> to continue ..."
- READ X:DTIME
- +4 SET X="?"
- DO DISP^XQORM1
- WRITE !
- +5 QUIT
- +6 ;
- REASON ; -- Get default Reason for Request text for Service
- +1 NEW ORIT,ORSERV,OROOT
- +2 SET ORIT=$GET(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
- +3 SET ORSERV=$PIECE($GET(^ORD(101.43,+ORIT,0)),U,2)
- if 'ORSERV!(ORSERV["99PRO")
- QUIT
- +4 SET OROOT=$NAME(^TMP("ORWORD",$JOB,PROMPT,INST))
- Begin DoDot:1
- +5 ;protect var's
- NEW PROMPT,INST,X,Y,DIR,ACTION,REQD,MULT,ITEM,COND
- +6 DO GETDEF^GMRCDRFR(OROOT,ORSERV,+$GET(ORVP),$SELECT($GET(ORVP):1,1:0))
- End DoDot:1
- +7 if $DATA(^TMP("ORWORD",$JOB,PROMPT,INST))
- SET Y=OROOT
- +8 QUIT
- +9 ;
- ENPDX ; -- setup Prov Dx field
- +1 NEW CODE
- +2 SET ORPDX=$$PROVDX^GMRCUTL1($SELECT($DATA(ORPROC):ORPROC,1:$GET(ORSERV)))
- +3 SET CODE=$$PTR^ORCD("OR GTX CODE")
- +4 IF $PIECE(ORPDX,U)="S"
- KILL ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST)
- SET COND="I 0"
- QUIT
- +5 if $GET(ORTYPE)'="Z"
- SET REQD=$SELECT($PIECE(ORPDX,U)="R":1,1:0)
- +6 if $PIECE(ORPDX,U,2)'="L"
- KILL ORDIALOG(CODE,INST)
- +7 IF $PIECE(ORPDX,U,2)="L"
- SET ORDIALOG(PROMPT,"?")="Select a preliminary diagnosis from the Lexicon, as text or an ICD code."
- if '$LENGTH($GET(ORDIALOG(CODE,INST)))
- KILL ORDIALOG(PROMPT,INST)
- +8 ;csv
- IF $LENGTH($GET(ORDIALOG(CODE,INST)))
- IF '$$STATCHK^ICDXCODE("DIAGNOSIS",ORDIALOG(CODE,INST),DT)
- Begin DoDot:1
- +9 DO EN^DDIOL("The existing diagnosis is associated with an inactive ICD-9 code.")
- +10 IF $GET(REQD)
- DO EN^DDIOL("Another code must be selected before proceeding.")
- +11 IF '$GET(REQD)
- DO EN^DDIOL("If another code is not selected, no code will be saved with the new order.")
- +12 DO EN^DDIOL(" ")
- +13 KILL ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST)
- +14 SET ACTION=$GET(ACTION)_"W"
- End DoDot:1
- +15 QUIT
- +16 ;
- LEX ; -- search Lexicon for Prov Dx
- +1 ;no change
- IF $LENGTH($GET(ORESET))
- IF ORESET=Y
- QUIT
- +2 IF Y?1." "
- KILL DONE
- WRITE !!,$CHAR(7),"Use of only spaces not allowed!",!
- QUIT
- +3 ;free text only, no ICD code
- if $PIECE(ORPDX,U,2)'="L"
- QUIT
- +4 NEW DIC,DUOUT,DTOUT,ORCS
- +5 SET ORCS="ICD"
- +6 IF DT>=$$IMPDATE^LEXU("10D")
- SET ORCS="10D"
- +7 DO CONFIG^LEXSET(ORCS,ORCS,DT)
- +8 SET DIC="^LEX(757.01,"
- SET DIC(0)="EQM"
- SET DIC("A")="Provisional Diagnosis: "
- +9 if $LENGTH($GET(ORESET))
- SET DIC("B")=ORESET
- +10 DO ^DIC
- IF Y'>0
- Begin DoDot:1
- +11 IF $LENGTH($GET(ORESET))
- SET ORDIALOG(PROMPT,ORI)=ORESET
- +12 IF '$TEST
- KILL ORDIALOG(PROMPT,ORI)
- +13 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET ORQUIT=1
- QUIT
- +14 IF REQD
- IF '$DATA(ORDIALOG(PROMPT,ORI))
- KILL DONE
- WRITE !!,$CHAR(7),$$REQUIRED^ORCDLG1,!
- End DoDot:1
- QUIT
- +15 SET ORDIALOG(PROMPT,ORI)=$PIECE(Y,U,2)
- +16 IF ORCS="ICD"
- SET ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$GET(Y(1))
- KILL Y(1)
- +17 IF ORCS="10D"
- SET ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$GET(Y(30))
- KILL Y(30)
- +18 QUIT
- +19 ;
- SERVMSG ; -- Get, display text message for service ORSERV
- +1 ;show first time only
- if '$GET(ORSERV)&('$GET(ORPROC))
- QUIT
- if 'FIRST
- QUIT
- +2 NEW ORTXT,I,CNT,HDR
- SET HDR=$SELECT($GET(ORMENU):5,1:7)
- +3 DO PREREQ^GMRCUTL1("ORTXT",$SELECT($DATA(ORPROC):ORPROC,1:ORSERV),+ORVP)
- +4 if '$DATA(ORTXT)
- QUIT
- +5 IF $DATA(ORPROC)
- WRITE !!,$$RJ^XLFSTR("** Procedure Pre-requisite **",57)
- +6 IF '$TEST
- WRITE !!,$$RJ^XLFSTR("** Consult Service Pre-requisite **",57)
- +7 SET (I,CNT)=0
- FOR
- SET I=$ORDER(ORTXT(I))
- if I'>0
- QUIT
- Begin DoDot:1
- +8 SET CNT=CNT+1
- IF CNT>(IOSL-HDR)
- SET CNT=0
- IF '$$CONT
- SET ORQUIT=1
- QUIT
- +9 WRITE !,ORTXT(I,0)
- End DoDot:1
- if $GET(ORQUIT)
- QUIT
- +10 if $GET(ORQUIT)
- QUIT
- if '$$CONT
- SET ORQUIT=1
- WRITE !
- +11 QUIT