| 1 | GMRCEDIT ;SLC/DCM,JFR - EDIT CANCELLED CONSULT-MAIN DRIVER ; 11/25/2000
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,18,47**;DEC 27, 1997
|
|---|
| 3 | ; Patch 18 newed variable DFN and added line tag VALPROV
|
|---|
| 4 | ; This routine invokes IA #2638,#2713,#2801,#10060
|
|---|
| 5 | EN(XQCON,XQDFN) ; -- main entry point for GMRCEDIT
|
|---|
| 6 | ;XQDFN=XQAID XQCON=XQADATA from CPRS alerts
|
|---|
| 7 | N GMRCNOTF,GMRCCORY,GMRCDA,GMRCO,DFN
|
|---|
| 8 | S DFN=$P(XQDFN,",",2),GMRCDA=$S(XQCON=+XQCON:+XQCON,+$P($P(XQCON,",",2),";",2):+$P($P(XQCON,",",2),";",2),XQCON?1N.N1",GMRC".E:+XQCON,1:$P($P(XQCON,";",3),",",1))
|
|---|
| 9 | S GMRCNOTF=+$P(XQDFN,",",3)
|
|---|
| 10 | I '+GMRCDA S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN),END Q
|
|---|
| 11 | S GMRCDAP=GMRCDA
|
|---|
| 12 | I '$$LOCK^GMRCA1(+GMRCDAP) D END Q
|
|---|
| 13 | N GMRCLCK S GMRCLCK=1 ;JFR
|
|---|
| 14 | ;S GMRCDAP=GMRCDA I +$P(^GMR(123,+GMRCDA,0),"^",5)
|
|---|
| 15 | S GMRCOK=$P(^ORD(100.01,$P(^GMR(123,+GMRCDA,0),"^",12),0),"^",1),GMRCOK=$S(GMRCOK["CANCELLED":1,1:0)
|
|---|
| 16 | I '$D(GMRCOK) S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN),END Q
|
|---|
| 17 | S GMRCPNM=$P(^DPT(DFN,0),"^",1)
|
|---|
| 18 | S GMRCPROV=$P($G(^GMR(123,GMRCDA,0)),"^",14) I 'GMRCPROV S GMRCPROV=$P($G(^GMR(123,GMRCDA,12)),"^",6)
|
|---|
| 19 | I +GMRCPROV S GMRCPROV=$P(^VA(200,GMRCPROV,0),"^",1)
|
|---|
| 20 | D EN^VALM("GMRC EDIT CONSULT") ;********* CALL TO LIST MANAGER
|
|---|
| 21 | I $S($O(GMRCED(0)):1,$D(^TMP("GMRCED",$J)):1,1:0),'$D(GMRCRSUB) D
|
|---|
| 22 | . N DIR,DTOUT,DUOUT,X,Y
|
|---|
| 23 | . W !,$C(7),"This Consult Has Not Been Resubmitted!!"
|
|---|
| 24 | . W !,"Resubmit Or All Edits Will Be Lost!!",!!
|
|---|
| 25 | . S DIR(0)="Y",DIR("A")="Do you wish to resubmit now? ",DIR("B")="YES"
|
|---|
| 26 | . D ^DIR I $D(DUOUT)!($D(DTOUT))!(Y<1) W !!,"No changes made!" Q
|
|---|
| 27 | . D EN^GMRCEDT2(GMRCDAP)
|
|---|
| 28 | . Q
|
|---|
| 29 | S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN)
|
|---|
| 30 | D END
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | HDR ; -- header code
|
|---|
| 34 | S VALMHDR(1)="Edit Consult for Patient "_GMRCPNM_" Consult Number: "_GMRCDA
|
|---|
| 35 | S VALMHDR(2)="Sending Provider: "_GMRCPROV
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | INIT ; -- init variables and list array
|
|---|
| 39 | K ^TMP("GMRCR",$J,"EDLIST")
|
|---|
| 40 | S DSPLINE=0,DATA="",VALMAR="^TMP(""GMRCR"",$J,""EDLIST"")"
|
|---|
| 41 | F LINE=1:1:GMRCLNO S DSPLINE=$O(^TMP("GMRCR",$J,"ED",DSPLINE)) Q:DSPLINE=""!(DSPLINE?1A.E) S DATA=^(DSPLINE,0) D SET^VALM10(LINE,DATA)
|
|---|
| 42 | S VALMCNT=GMRCLNO,VALMPGE=1,XQORM("A")="Select Action: "
|
|---|
| 43 | K DSPLINE,DATA,LINE
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | HELP ; -- help code
|
|---|
| 47 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | VALPROV(GMRCIEN) ; Check Provider or Update authority.
|
|---|
| 51 | I DUZ=$P(^GMR(123,+GMRCIEN,0),"^",14) Q 1
|
|---|
| 52 | I $$VALID^GMRCAU($P(^GMR(123,+GMRCIEN,0),"^",5)) Q 1
|
|---|
| 53 | Q 0
|
|---|
| 54 | EXIT ;
|
|---|
| 55 | ;Don't kill anything here
|
|---|
| 56 | Q
|
|---|
| 57 | END ; -- exit code
|
|---|
| 58 | I $G(GMRCLCK) D UNLOCK^GMRCA1(+GMRCDAP) ;JFR
|
|---|
| 59 | K ^TMP("GMRCR",$J,"EDLIST"),^TMP("GMRCR",$J,"ED")
|
|---|
| 60 | K ^TMP("GMRCED",$J),^TMP("GMRCSUB",$J),^TMP("GMRCFLD20",$J)
|
|---|
| 61 | K CMDA,DFN,DIC,DIE,DR,DA,FLDA,FLDNM,GMRCA,GMRCATN,GMRCD,GMRCDD,GMRCANS,GMRCDIAG,GMRCED,GMRCEDCM,GMRCIND,GMRCINO,GMRCKEEP,GMRCLNO,GMRCND,GMRCND1,GMRCO,GMRCOK,GMRCPC,GMRCPL,GMRCPR,GMRCPNM,GMRCPROC,GMRCPROV,GMRCREQ,GMRCRQT
|
|---|
| 62 | K GMRCFLD,GMRCOUNT,GMRCRSUB,GMRCSS,GMRCURG,GMRCDA,GMRCDAP,GMRCDA1,ND,TRKDA,XQAKILL
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | EXPND ; -- expand code
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
