- ORCONSLT ;SLC/MKB-Consult actions ;6/7/01 07:28
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,48,68,100**;Dec 17, 1997
- ; External References
- ; DBIA 2424 Call to APIs COMMENT, DC, EDTSUB, PS, and RC in
- ; routine GMRCA1
- ; DBIA 2425 Call to CPRS^GMRCACTM
- ; DBIA 2395 Call to FR^GMRCAFRD
- ; DBIA 2901 Call to SF^GMRCASF
- ; DBIA 3120 Call to DIS^GMRCDIS
- ; DBIA 2427 Call to APIs ADDEND and ENTER in routine GMRCTIU
- ; DBIA 10140 Call to EN^XQORM
- EN ; -- main entry point
- N ORCMENU,XQORM,Y,ORFLG S VALMBCK=""
- S ORNMBR=$P(XQORNOD(0),"=",2) D SELECT^ORCHART(ORNMBR)
- S ORCMENU=$S($$SERVMENU:"SERVICE",1:"USER")
- S XQORM=+$O(^ORD(101,"B","ORC CONSULT "_ORCMENU_" MENU",0))_";ORD(101,"
- S XQORM(0)="1AD"_$S(ORCMENU="USER":"",1:"\"),XQORM("A")="Select action: ",XQORM("M")=+$P($G(^ORD(101,+XQORM,4)),U,2)
- W ! D EN^XQORM G:Y'>0 ENQ
- X:$D(^ORD(101,+$P(Y(1),U,2),20)) ^(20)
- ENQ D DESELECT^ORCHART(ORNMBR):'$G(OREBUILD)
- Q
- ;
- EN1(ORACT) ; -- Action ORACT on consults
- N ORLK,ORI,NMBR,ORQUIT,ORIDX,ID,GMRCACT,X
- S VALMBCK="" Q:'$L($G(ORACT))
- I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR N ORCMENU,ORFLG S ORCMENU=$S($$SERVMENU:"SERVICE",1:"USER")
- D FREEZE^ORCMENU S VALMBCK="R"
- F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR,$L($T(@ORACT)) S ORIDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)) D Q:$G(ORQUIT)
- . S ID=$P(ORIDX,U),X=$P(ORIDX,U,4) Q:'ID D SUBHDR^ORCACT(X)
- . I (ORACT="CMMT")!(ORACT="PRNT")!(ORACT="EDITRES")!($G(ORFLG(ID))>1) D @ORACT Q
- . W !,"Insufficient privilege for this service!" H 2
- I $G(OREBUILD) D TAB^ORCHART(ORTAB,1) S $P(^TMP("OR",$J,"ORDERS",0),U)=""
- Q
- ;
- EDITRES ;Edit/Resubmit consult
- D EDTSUB^GMRCA1(+ID) S OREBUILD=1
- Q
- REC ; -- Receive consult
- D RC^GMRCA1(+ID) S OREBUILD=1
- Q
- ;
- SCHED ; -- Schedule consult
- D RC^GMRCA1(+ID,1) S OREBUILD=1
- Q
- ;
- RR ; -- Reroute consult
- D FR^GMRCAFRD(+ID) S OREBUILD=1
- Q
- ;
- CMMT ; -- Add comment to consult order
- D COMMENT^GMRCA1(+ID)
- Q
- ;
- COMP ; -- Complete consult
- ;S GMRCACT="COMPLETE" D DC^GMRCA1(+ID)
- D ENTER^GMRCTIU(+ID) S OREBUILD=1
- Q
- ;
- REMRSLT ; -- Remove Medicine Results
- I '$L($T(DIS^GMRCDIS)) W !!,"This action is not available yet." H 2 Q
- D DIS^GMRCDIS(+ID) S OREBUILD=1
- Q
- ;
- DC ; -- Discontinue consult
- S GMRCACT="DISCONTINUE" D DC^GMRCA1(+ID,6) S OREBUILD=1
- Q
- ;
- DENY ; -- Deny consult request
- S GMRCACT="DENY" D DC^GMRCA1(+ID,19) S OREBUILD=1
- Q
- ;
- FWD ; -- Forward consult request to other services
- ;D RR^GMRCAFWD(+ID) S OREBUILD=1
- W !!,"No longer available." H 1
- Q
- ;
- PRNT ; -- Print consult form
- D PS^GMRCA1(+ID)
- Q
- ;
- SIGF ; -- Significant Findings
- I '$L($T(SF^GMRCASF)) W !!,"This action is not available yet." H 2 Q
- D SF^GMRCASF(+ID) S OREBUILD=1
- Q
- ;
- ADDEND ; -- Make an addendum to the consult result
- D ADDEND^GMRCTIU(+ID) S OREBUILD=1
- Q
- ;
- N NMBR,I,X,Y S X="",Y=0
- I '$L($T(CPRS^GMRCACTM)) G SMQ
- F I=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",I) I NMBR S X=X_$S($L(X):";",1:"")_+$P($G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),U)
- G:'$L(X) SMQ D CPRS^GMRCACTM(X) ; builds ORFLG(GMRCIEN)=<menu>
- S I=0 F S I=$O(ORFLG(I)) Q:I'>0 I ORFLG(I)>1 S Y=1 Q
- SMQ Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONSLT 3282 printed Dec 13, 2024@02:28:49 Page 2
- ORCONSLT ;SLC/MKB-Consult actions ;6/7/01 07:28
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,48,68,100**;Dec 17, 1997
- +2 ; External References
- +3 ; DBIA 2424 Call to APIs COMMENT, DC, EDTSUB, PS, and RC in
- +4 ; routine GMRCA1
- +5 ; DBIA 2425 Call to CPRS^GMRCACTM
- +6 ; DBIA 2395 Call to FR^GMRCAFRD
- +7 ; DBIA 2901 Call to SF^GMRCASF
- +8 ; DBIA 3120 Call to DIS^GMRCDIS
- +9 ; DBIA 2427 Call to APIs ADDEND and ENTER in routine GMRCTIU
- +10 ; DBIA 10140 Call to EN^XQORM
- EN ; -- main entry point
- +1 NEW ORCMENU,XQORM,Y,ORFLG
- SET VALMBCK=""
- +2 SET ORNMBR=$PIECE(XQORNOD(0),"=",2)
- DO SELECT^ORCHART(ORNMBR)
- +3 SET ORCMENU=$SELECT($$SERVMENU:"SERVICE",1:"USER")
- +4 SET XQORM=+$ORDER(^ORD(101,"B","ORC CONSULT "_ORCMENU_" MENU",0))_";ORD(101,"
- +5 SET XQORM(0)="1AD"_$SELECT(ORCMENU="USER":"",1:"\")
- SET XQORM("A")="Select action: "
- SET XQORM("M")=+$PIECE($GET(^ORD(101,+XQORM,4)),U,2)
- +6 WRITE !
- DO EN^XQORM
- if Y'>0
- GOTO ENQ
- +7 if $DATA(^ORD(101,+$PIECE(Y(1),U,2),20))
- XECUTE ^(20)
- ENQ if '$GET(OREBUILD)
- DO DESELECT^ORCHART(ORNMBR)
- +1 QUIT
- +2 ;
- EN1(ORACT) ; -- Action ORACT on consults
- +1 NEW ORLK,ORI,NMBR,ORQUIT,ORIDX,ID,GMRCACT,X
- +2 SET VALMBCK=""
- if '$LENGTH($GET(ORACT))
- QUIT
- +3 IF '$GET(ORNMBR)
- SET ORNMBR=$$ORDERS^ORCHART("")
- if 'ORNMBR
- QUIT
- NEW ORCMENU,ORFLG
- SET ORCMENU=$SELECT($$SERVMENU:"SERVICE",1:"USER")
- +4 DO FREEZE^ORCMENU
- SET VALMBCK="R"
- +5 FOR ORI=1:1:$LENGTH(ORNMBR,",")
- SET NMBR=$PIECE(ORNMBR,",",ORI)
- IF NMBR
- IF $LENGTH($TEXT(@ORACT))
- SET ORIDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
- Begin DoDot:1
- +6 SET ID=$PIECE(ORIDX,U)
- SET X=$PIECE(ORIDX,U,4)
- if 'ID
- QUIT
- DO SUBHDR^ORCACT(X)
- +7 IF (ORACT="CMMT")!(ORACT="PRNT")!(ORACT="EDITRES")!($GET(ORFLG(ID))>1)
- DO @ORACT
- QUIT
- +8 WRITE !,"Insufficient privilege for this service!"
- HANG 2
- End DoDot:1
- if $GET(ORQUIT)
- QUIT
- +9 IF $GET(OREBUILD)
- DO TAB^ORCHART(ORTAB,1)
- SET $PIECE(^TMP("OR",$JOB,"ORDERS",0),U)=""
- +10 QUIT
- +11 ;
- EDITRES ;Edit/Resubmit consult
- +1 DO EDTSUB^GMRCA1(+ID)
- SET OREBUILD=1
- +2 QUIT
- REC ; -- Receive consult
- +1 DO RC^GMRCA1(+ID)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- SCHED ; -- Schedule consult
- +1 DO RC^GMRCA1(+ID,1)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- RR ; -- Reroute consult
- +1 DO FR^GMRCAFRD(+ID)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- CMMT ; -- Add comment to consult order
- +1 DO COMMENT^GMRCA1(+ID)
- +2 QUIT
- +3 ;
- COMP ; -- Complete consult
- +1 ;S GMRCACT="COMPLETE" D DC^GMRCA1(+ID)
- +2 DO ENTER^GMRCTIU(+ID)
- SET OREBUILD=1
- +3 QUIT
- +4 ;
- REMRSLT ; -- Remove Medicine Results
- +1 IF '$LENGTH($TEXT(DIS^GMRCDIS))
- WRITE !!,"This action is not available yet."
- HANG 2
- QUIT
- +2 DO DIS^GMRCDIS(+ID)
- SET OREBUILD=1
- +3 QUIT
- +4 ;
- DC ; -- Discontinue consult
- +1 SET GMRCACT="DISCONTINUE"
- DO DC^GMRCA1(+ID,6)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- DENY ; -- Deny consult request
- +1 SET GMRCACT="DENY"
- DO DC^GMRCA1(+ID,19)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- FWD ; -- Forward consult request to other services
- +1 ;D RR^GMRCAFWD(+ID) S OREBUILD=1
- +2 WRITE !!,"No longer available."
- HANG 1
- +3 QUIT
- +4 ;
- PRNT ; -- Print consult form
- +1 DO PS^GMRCA1(+ID)
- +2 QUIT
- +3 ;
- SIGF ; -- Significant Findings
- +1 IF '$LENGTH($TEXT(SF^GMRCASF))
- WRITE !!,"This action is not available yet."
- HANG 2
- QUIT
- +2 DO SF^GMRCASF(+ID)
- SET OREBUILD=1
- +3 QUIT
- +4 ;
- ADDEND ; -- Make an addendum to the consult result
- +1 DO ADDEND^GMRCTIU(+ID)
- SET OREBUILD=1
- +2 QUIT
- +3 ;
- +1 NEW NMBR,I,X,Y
- SET X=""
- SET Y=0
- +2 IF '$LENGTH($TEXT(CPRS^GMRCACTM))
- GOTO SMQ
- +3 FOR I=1:1:$LENGTH(ORNMBR,",")
- SET NMBR=$PIECE(ORNMBR,",",I)
- IF NMBR
- SET X=X_$SELECT($LENGTH(X):";",1:"")_+$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR)),U)
- +4 ; builds ORFLG(GMRCIEN)=<menu>
- if '$LENGTH(X)
- GOTO SMQ
- DO CPRS^GMRCACTM(X)
- +5 SET I=0
- FOR
- SET I=$ORDER(ORFLG(I))
- if I'>0
- QUIT
- IF ORFLG(I)>1
- SET Y=1
- QUIT
- SMQ QUIT Y