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 ;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
  1. ; External References
  1. ; Reference to ^DIC supported by ICR 10006
  1. ; Reference to ^DIR supported by ICR 10026
  1. ; Reference to SERV1^GMRCASV supported by ICR 2426
  1. ; Reference to GETDEF^GMRCDRFR supported by ICR 3119
  1. ; Reference to GETSVC^GMRCPR0 supported by ICR 2982
  1. ; Reference to $$PROVDX and PREREQ^GMRCUTL1 supported by ICR 3121
  1. ; Reference to CONFIG^LEXSET supported by ICR 1609
  1. ; Reference to $$RJ and $$UP^XLFSTR supported by ICR 10104
  1. ; Reference to DISP^XQORM1 supported by ICR 10102
  1. ; Reference to $$STATCHK^ICDAPIU supported by ICR 3991
  1. CID ;--validates date and enforces any associated parameters
  1. ;called from GMRCOR CONSULT, Clinically Indicated Date POST-SELECTION ACTION
  1. Q:$G(ORTYPE)'="Z"
  1. I $G(ORDIALOG(PROMPT,INST))'["T" K DONE W $C(7),!,"Response must be relative date (e.g. TODAY, T+7D, T+3M)"
  1. 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,".")
  1. S FUTDAYS=$$GET^XPAR("PKG","ORCDGMRC FUTURE DATE LIMIT",1,"I") S:$G(FUTDAYS)>0 FUTDATE=$$FMADD^XLFDT(DT,FUTDAYS)
  1. I ORDATE>FUTDATE K DONE W $C(7),!,"Response cannot be more than "_FUTDAYS_" days in the future."
  1. Q
  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^ICDXCODE("DIAGNOSIS",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,ORCS
  1. S ORCS="ICD"
  1. I DT>=$$IMPDATE^LEXU("10D") S ORCS="10D"
  1. D CONFIG^LEXSET(ORCS,ORCS,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. I ORCS="ICD" S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(1)) K Y(1)
  1. I ORCS="10D" S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(30)) K Y(30)
  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