GMRCEDIT ;SLC/DCM,JFR - EDIT CANCELLED CONSULT-MAIN DRIVER ;04/23/09 11:36
;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,18,47,66**;DEC 27, 1997;Build 30
; Patch 18 newed variable DFN and added line tag VALPROV
; This routine invokes IA #2638 (^ORD(100.01), #2713 (ORB3F1), #10060 (access ^VA(200))
;#2690 (ORB3FUP1), #10118 (EN^VAML), #10117 (SET^VAML10), #10102 (XQORM1), #10026 (DIR), #2056 (GET1^DIQ)
EN(XQCON,XQDFN) ; -- main entry point for GMRCEDIT
;XQDFN=XQAID XQCON=XQADATA from CPRS alerts
N GMRCNOTF,GMRCCORY,GMRCDA,GMRCO,DFN
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))
S GMRCNOTF=+$P(XQDFN,",",3)
I '+GMRCDA S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN),END Q
S GMRCDAP=GMRCDA
I '$$LOCK^GMRCA1(+GMRCDAP) D END Q
N GMRCLCK S GMRCLCK=1 ;JFR
;S GMRCDAP=GMRCDA I +$P(^GMR(123,+GMRCDA,0),"^",5)
S GMRCOK=$P(^ORD(100.01,$P(^GMR(123,+GMRCDA,0),"^",12),0),"^",1),GMRCOK=$S(GMRCOK["CANCELLED":1,1:0)
I '$D(GMRCOK) S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN),END Q
S GMRCPNM=$P(^DPT(DFN,0),"^",1)
S GMRCPROV=$P($G(^GMR(123,GMRCDA,0)),"^",14) I 'GMRCPROV S GMRCPROV=$P($G(^GMR(123,GMRCDA,12)),"^",6)
I +GMRCPROV S GMRCPROV=$$GET1^DIQ(200,GMRCPROV,.01) ;wat/66 replaced direct read of ^VA(200
D EN^VALM("GMRC EDIT CONSULT") ;********* CALL TO LIST MANAGER
I $S($O(GMRCED(0)):1,$D(^TMP("GMRCED",$J)):1,1:0),'$D(GMRCRSUB) D
. N DIR,DTOUT,DUOUT,X,Y
. W !,$C(7),"This Consult Has Not Been Resubmitted!!"
. W !,"Resubmit Or All Edits Will Be Lost!!",!!
. S DIR(0)="Y",DIR("A")="Do you wish to resubmit now? ",DIR("B")="YES"
. D ^DIR I $D(DUOUT)!($D(DTOUT))!(Y<1) W !!,"No changes made!" Q
. D EN^GMRCEDT2(GMRCDAP)
. Q
S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,XQDFN)
D END
Q
;
HDR ; -- header code
S VALMHDR(1)="Edit Consult for Patient "_GMRCPNM_" Consult Number: "_GMRCDA
S VALMHDR(2)="Sending Provider: "_GMRCPROV
Q
;
INIT ; -- init variables and list array
K ^TMP("GMRCR",$J,"EDLIST")
S DSPLINE=0,DATA="",VALMAR="^TMP(""GMRCR"",$J,""EDLIST"")"
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)
S VALMCNT=GMRCLNO,VALMPGE=1,XQORM("A")="Select Action: "
K DSPLINE,DATA,LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
VALPROV(GMRCIEN) ; Check Provider or Update authority.
I DUZ=$P(^GMR(123,+GMRCIEN,0),"^",14) Q 1
I $$VALID^GMRCAU($P(^GMR(123,+GMRCIEN,0),"^",5)) Q 1
Q 0
EXIT ;
;Don't kill anything here
Q
END ; -- exit code
I $G(GMRCLCK) D UNLOCK^GMRCA1(+GMRCDAP) ;JFR
K ^TMP("GMRCR",$J,"EDLIST"),^TMP("GMRCR",$J,"ED")
K ^TMP("GMRCED",$J),^TMP("GMRCSUB",$J),^TMP("GMRCFLD20",$J)
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
K GMRCFLD,GMRCOUNT,GMRCRSUB,GMRCSS,GMRCURG,GMRCDA,GMRCDAP,GMRCDA1,ND,TRKDA,XQAKILL,GMRCERDT
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCEDIT 3230 printed Oct 16, 2024@17:46:22 Page 2
GMRCEDIT ;SLC/DCM,JFR - EDIT CANCELLED CONSULT-MAIN DRIVER ;04/23/09 11:36
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,18,47,66**;DEC 27, 1997;Build 30
+2 ; Patch 18 newed variable DFN and added line tag VALPROV
+3 ; This routine invokes IA #2638 (^ORD(100.01), #2713 (ORB3F1), #10060 (access ^VA(200))
+4 ;#2690 (ORB3FUP1), #10118 (EN^VAML), #10117 (SET^VAML10), #10102 (XQORM1), #10026 (DIR), #2056 (GET1^DIQ)
EN(XQCON,XQDFN) ; -- main entry point for GMRCEDIT
+1 ;XQDFN=XQAID XQCON=XQADATA from CPRS alerts
+2 NEW GMRCNOTF,GMRCCORY,GMRCDA,GMRCO,DFN
+3 SET DFN=$PIECE(XQDFN,",",2)
SET GMRCDA=$SELECT(XQCON=+XQCON:+XQCON,+$PIECE($PIECE(XQCON,",",2),";",2):+$PIECE($PIECE(XQCON,",",2),";",2),XQCON?1N.N1",GMRC".E:+XQCON,1:$PIECE($PIECE(XQCON,";",3),",",1))
+4 SET GMRCNOTF=+$PIECE(XQDFN,",",3)
+5 IF '+GMRCDA
SET XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
DO DEL^ORB3FUP1(.GMRCCORY,XQDFN)
DO END
QUIT
+6 SET GMRCDAP=GMRCDA
+7 IF '$$LOCK^GMRCA1(+GMRCDAP)
DO END
QUIT
+8 ;JFR
NEW GMRCLCK
SET GMRCLCK=1
+9 ;S GMRCDAP=GMRCDA I +$P(^GMR(123,+GMRCDA,0),"^",5)
+10 SET GMRCOK=$PIECE(^ORD(100.01,$PIECE(^GMR(123,+GMRCDA,0),"^",12),0),"^",1)
SET GMRCOK=$SELECT(GMRCOK["CANCELLED":1,1:0)
+11 IF '$DATA(GMRCOK)
SET XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
DO DEL^ORB3FUP1(.GMRCCORY,XQDFN)
DO END
QUIT
+12 SET GMRCPNM=$PIECE(^DPT(DFN,0),"^",1)
+13 SET GMRCPROV=$PIECE($GET(^GMR(123,GMRCDA,0)),"^",14)
IF 'GMRCPROV
SET GMRCPROV=$PIECE($GET(^GMR(123,GMRCDA,12)),"^",6)
+14 ;wat/66 replaced direct read of ^VA(200
IF +GMRCPROV
SET GMRCPROV=$$GET1^DIQ(200,GMRCPROV,.01)
+15 ;********* CALL TO LIST MANAGER
DO EN^VALM("GMRC EDIT CONSULT")
+16 IF $SELECT($ORDER(GMRCED(0)):1,$DATA(^TMP("GMRCED",$JOB)):1,1:0)
IF '$DATA(GMRCRSUB)
Begin DoDot:1
+17 NEW DIR,DTOUT,DUOUT,X,Y
+18 WRITE !,$CHAR(7),"This Consult Has Not Been Resubmitted!!"
+19 WRITE !,"Resubmit Or All Edits Will Be Lost!!",!!
+20 SET DIR(0)="Y"
SET DIR("A")="Do you wish to resubmit now? "
SET DIR("B")="YES"
+21 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y<1)
WRITE !!,"No changes made!"
QUIT
+22 DO EN^GMRCEDT2(GMRCDAP)
+23 QUIT
End DoDot:1
+24 SET XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
DO DEL^ORB3FUP1(.GMRCCORY,XQDFN)
+25 DO END
+26 QUIT
+27 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Edit Consult for Patient "_GMRCPNM_" Consult Number: "_GMRCDA
+2 SET VALMHDR(2)="Sending Provider: "_GMRCPROV
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("GMRCR",$JOB,"EDLIST")
+2 SET DSPLINE=0
SET DATA=""
SET VALMAR="^TMP(""GMRCR"",$J,""EDLIST"")"
+3 FOR LINE=1:1:GMRCLNO
SET DSPLINE=$ORDER(^TMP("GMRCR",$JOB,"ED",DSPLINE))
if DSPLINE=""!(DSPLINE?1A.E)
QUIT
SET DATA=^(DSPLINE,0)
DO SET^VALM10(LINE,DATA)
+4 SET VALMCNT=GMRCLNO
SET VALMPGE=1
SET XQORM("A")="Select Action: "
+5 KILL DSPLINE,DATA,LINE
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
VALPROV(GMRCIEN) ; Check Provider or Update authority.
+1 IF DUZ=$PIECE(^GMR(123,+GMRCIEN,0),"^",14)
QUIT 1
+2 IF $$VALID^GMRCAU($PIECE(^GMR(123,+GMRCIEN,0),"^",5))
QUIT 1
+3 QUIT 0
EXIT ;
+1 ;Don't kill anything here
+2 QUIT
END ; -- exit code
+1 ;JFR
IF $GET(GMRCLCK)
DO UNLOCK^GMRCA1(+GMRCDAP)
+2 KILL ^TMP("GMRCR",$JOB,"EDLIST"),^TMP("GMRCR",$JOB,"ED")
+3 KILL ^TMP("GMRCED",$JOB),^TMP("GMRCSUB",$JOB),^TMP("GMRCFLD20",$JOB)
+4 KILL 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
+5 KILL GMRCFLD,GMRCOUNT,GMRCRSUB,GMRCSS,GMRCURG,GMRCDA,GMRCDAP,GMRCDA1,ND,TRKDA,XQAKILL,GMRCERDT
+6 QUIT
+7 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
