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

ORCDGMRC.m

Go to the documentation of this file. 
  1. ORCDGMRC ;SLC/MKB-Utility functions for GMRC dialogs ;3/10/03  07:34
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,68,100,181**;Dec 17, 1997
  1.  ; External References
  1.  ;    DBIA 10006 Call to ^DIC
  1.  ;    DBIA 10026 Call to ^DIR
  1.  ;    DBIA  2426 Call to SERV1^GMRCASV
  1.  ;    DBIA  3119 Call to GETDEF^GMRCDRFR
  1.  ;    DBIA  2982 Call to GETSVC^GMRCPR0
  1.  ;    DBIA  3121 Call to APIs $$PROVDX and PREREQ in routine ^GMRCUTL1
  1.  ;    DBIA  1609 Call to CONFIG^LEXSET
  1.  ;    DBIA 10104 Call to APIs $$RJ and $$UP in routine ^XLFSTR
  1.  ;    DBIA 10102 Call to DISP^XQORM1
  1.  ;    DBIA  3991 Call to $$STATCHK^ICDAPIU
  1. URGENCY(TYPE) ; -- Returns index of allowable urgencies from file #101.42
  1.  N X S X=$S($$VAL^ORCD("CATEGORY")'="I":"O",TYPE="C":"T",1:"R")
  1.  S ORDIALOG(PROMPT,"D")="S.GMRC"_X
  1.  Q
  1.  ;
  1. PLACE ; -- Returns list of allowable places of consultation
  1.  Q:$D(ORDIALOG(PROMPT,"LIST"))  N CHOICES,I,J,INPT,X
  1.  S INPT=($$VAL^ORCD("CATEGORY")="I")
  1.  I INPT S CHOICES="B^Bedside;C^Consultant's Choice"
  1.  I 'INPT S CHOICES="E^Emergency Room;C^Consultant's Choice"
  1.  S I=0 F J=1:1:$L(CHOICES,";") S X=$P(CHOICES,";",J) D
  1.  . S I=I+1,ORDIALOG(PROMPT,"LIST",I)=X
  1.  . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR($P(X,U,2)))=$P(X,U)
  1.  S ORDIALOG(PROMPT,"LIST")=I_"^1"
  1.  Q
  1.  ;
  1. CHANGED(PRMT) ; -- Kill lists for Request Service or Place of Consultation
  1.  N I,P
  1.  S I=$S(PRMT="OI":"REQUEST SERVICE",1:"PLACE OF CONSULTATION")
  1.  S P=$$PTR^ORCD("OR GTX "_I) Q:'P
  1.  K ORDIALOG(P,"LIST"),ORDIALOG(P,1)
  1.  Q
  1.  ;
  1. GETSERV ; -- Get list of orderable services
  1.  N GMRCTO,GMRCDG,I,X K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
  1.  S (GMRCTO,GMRCDG)=1 D SERV1^GMRCASV ; get list of orderable services
  1.  F I=1:1 S X=+$G(^TMP("GMRCSLIST",$J,I)) Q:X'>0  S $P(^TMP("GMRCS",$J,X),U,2)=I
  1.  Q
  1.  ;
  1. LISTSERV(ORI) ; -- List Consult services from ORSERV
  1.  N ORSTK,ORCNT,ORX,ORQ
  1.  W !,"Choose from:" S:$G(ORI)'>0 ORI=1
  1.  S (ORSTK,ORQ)=0,ORCNT=1,ORSTK(0)=$P(^TMP("GMRCSLIST",$J,ORI),U,3)
  1.  F  S ORX=$G(^TMP("GMRCSLIST",$J,ORI)) Q:ORX=""  D  Q:ORQ  S ORI=ORI+1
  1.  . I $P(ORX,U,3)'=+$G(ORSTK(ORSTK)) D POP I ORSTK'>0 S ORQ=1 Q
  1.  . S ORCNT=ORCNT+1 I ORCNT>(IOSL-6) S:'$$CONT ORQ=1 Q:$G(ORQ)  S ORCNT=1
  1.  . W !,?((ORSTK*2)),$P(ORX,U,2)
  1.  . W:$P(ORX,U,5) "  ("_$S($P(ORX,U,5)=1:"Grouper",1:"Tracking")_" Only)"
  1.  . I $P(ORX,U,4)="+" S ORSTK=ORSTK+1,ORSTK(ORSTK)=+ORX
  1.  Q
  1.  ;
  1. POP ; -- pop stack
  1.  S ORSTK=ORSTK-1 Q:ORSTK'>0
  1.  I ORSTK(ORSTK)'=$P(ORX,U,3) G POP
  1.  Q
  1.  ;
  1. CONT() ; -- continue?
  1.  N X,Y,DIR S DIR(0)="E" D ^DIR
  1.  Q +Y
  1.  ;
  1. CKSERV ; -- Ck service usage in Post-Selection Action
  1.  N GMRCI,ORI
  1.  S GMRCI=+$P(^ORD(101.43,+Y,0),U,2)
  1.  S ORI=+$P($G(^TMP("GMRCS",$J,GMRCI)),U,2) S:ORI'>0 ORI=1
  1.  I $P($G(^TMP("GMRCSLIST",$J,ORI)),U,5)=1 D LISTSERV^ORCDGMRC(ORI) K DONE
  1.  Q
  1.  ;
  1. PROCSVC ; -- Get list of services for procedure
  1.  Q:$D(ORDIALOG(PROMPT,"LIST"))  Q:'$L($T(GETSVC^GMRCPR0))
  1.  N OI,PROTCL,ORY,ORI,X
  1.  S OI=+$$VAL^ORCD("PROCEDURE"),PROTCL=$P($G(^ORD(101.43,OI,0)),U,2) ;ID
  1.  D:PROTCL GETSVC^GMRCPR0(.ORY,PROTCL)
  1.  I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!" H 1 S ORQUIT=1 Q
  1.  M ORDIALOG(PROMPT,"LIST")=ORY S $P(ORDIALOG(PROMPT,"LIST"),U,2)=1
  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)
  1.  Q
  1.  ;
  1. CKPROCSV ; -- Make sure procedure has at least one service
  1.  N PROT,ORY S PROT=$P($G(^ORD(101.43,+Y,0)),U,2)
  1.  D GETSVC^GMRCPR0(.ORY,PROT) I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!",! K DONE
  1.  Q
  1.  ;
  1. NWHELP ; -- help code for NW action
  1.  N X
  1.  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."
  1.  W !!,"Press <return> to continue ..." R X:DTIME
  1.  S X="?" D DISP^XQORM1 W !
  1.  Q
  1.  ;
  1. REASON ; -- Get default Reason for Request text for Service
  1.  N ORIT,ORSERV,OROOT
  1.  S ORIT=$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
  1.  S ORSERV=$P($G(^ORD(101.43,+ORIT,0)),U,2) Q:'ORSERV!(ORSERV["99PRO")
  1.  S OROOT=$NA(^TMP("ORWORD",$J,PROMPT,INST)) D
  1.  . N PROMPT,INST,X,Y,DIR,ACTION,REQD,MULT,ITEM,COND ;protect var's
  1.  . D GETDEF^GMRCDRFR(OROOT,ORSERV,+$G(ORVP),$S($G(ORVP):1,1:0))
  1.  S:$D(^TMP("ORWORD",$J,PROMPT,INST)) Y=OROOT
  1.  Q
  1.  ;
  1. ENPDX ; -- setup Prov Dx field
  1.  N CODE
  1.  S ORPDX=$$PROVDX^GMRCUTL1($S($D(ORPROC):ORPROC,1:$G(ORSERV)))
  1.  S CODE=$$PTR^ORCD("OR GTX CODE")
  1.  I $P(ORPDX,U)="S" K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST) S COND="I 0" Q
  1.  S:$G(ORTYPE)'="Z" REQD=$S($P(ORPDX,U)="R":1,1:0)
  1.  K:$P(ORPDX,U,2)'="L" ORDIALOG(CODE,INST)
  1.  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)
  1.  I $L($G(ORDIALOG(CODE,INST))),'$$STATCHK^ICDAPIU(ORDIALOG(CODE,INST),DT)  D  ;csv
  1.  . D EN^DDIOL("The existing diagnosis is associated with an inactive ICD-9 code.")
  1.  . I $G(REQD) D EN^DDIOL("Another code must be selected before proceeding.")
  1.  . I '$G(REQD) D EN^DDIOL("If another code is not selected, no code will be saved with the new order.")
  1.  . D EN^DDIOL(" ")
  1.  . K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST)
  1.  . S ACTION=$G(ACTION)_"W"
  1.  Q
  1.  ;
  1. LEX ; -- search Lexicon for Prov Dx
  1.  I $L($G(ORESET)),ORESET=Y Q  ;no change
  1.  I Y?1." " K DONE W !!,$C(7),"Use of only spaces not allowed!",! Q
  1.  Q:$P(ORPDX,U,2)'="L"  ;free text only, no ICD code
  1.  N DIC,DUOUT,DTOUT
  1.  D CONFIG^LEXSET("ICD","ICD",DT)
  1.  S DIC="^LEX(757.01,",DIC(0)="EQM",DIC("A")="Provisional Diagnosis: "
  1.  S:$L($G(ORESET)) DIC("B")=ORESET
  1.  D ^DIC I Y'>0 D  Q
  1.  . I $L($G(ORESET)) S ORDIALOG(PROMPT,ORI)=ORESET
  1.  . E  K ORDIALOG(PROMPT,ORI)
  1.  . I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
  1.  . I REQD,'$D(ORDIALOG(PROMPT,ORI)) K DONE W !!,$C(7),$$REQUIRED^ORCDLG1,!
  1.  S ORDIALOG(PROMPT,ORI)=$P(Y,U,2)
  1.  S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(1)) K Y(1)
  1.  Q
  1.  ;
  1. SERVMSG ; -- Get, display text message for service ORSERV
  1.  Q:'$G(ORSERV)&('$G(ORPROC))  Q:'FIRST  ;show first time only
  1.  N ORTXT,I,CNT,HDR S HDR=$S($G(ORMENU):5,1:7)
  1.  D PREREQ^GMRCUTL1("ORTXT",$S($D(ORPROC):ORPROC,1:ORSERV),+ORVP)
  1.  Q:'$D(ORTXT)
  1.  I $D(ORPROC) W !!,$$RJ^XLFSTR("** Procedure Pre-requisite **",57)
  1.  E  W !!,$$RJ^XLFSTR("** Consult Service Pre-requisite **",57)
  1.  S (I,CNT)=0 F  S I=$O(ORTXT(I)) Q:I'>0  D  Q:$G(ORQUIT)
  1.  . S CNT=CNT+1 I CNT>(IOSL-HDR) S CNT=0 I '$$CONT S ORQUIT=1 Q
  1.  . W !,ORTXT(I,0)
  1.  Q:$G(ORQUIT)  S:'$$CONT ORQUIT=1 W !
  1.  Q