Routine: GMRCEDIT

GMRCEDIT ;SLC/DCM,JFR - EDIT CANCELLED CONSULT-MAIN DRIVER ; 11/25/2000

 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,18,47**;DEC 27, 1997

 ; Patch 18 newed variable DFN and added line tag VALPROV

 ; This routine invokes IA #2638,#2713,#2801,#10060

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=$P(^VA(200,GMRCPROV,0),"^",1)

 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

HDR ; -- header code

 S VALMHDR(1)="Edit Consult for Patient "_GMRCPNM_"  Consult Number: "_GMRCDA

 S VALMHDR(2)="Sending Provider: "_GMRCPROV

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

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

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

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

EXPND ; -- expand code

GMRCEDIT  ;SLC/DCM,JFR - EDIT CANCELLED CONSULT-MAIN DRIVER ; 11/25/2000

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,18,47**;DEC 27, 1997

 +2       ; Patch 18 newed variable DFN and added line tag VALPROV

 +3       ; This routine invokes IA #2638,#2713,#2801,#10060

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       IF +GMRCPROV

               SET GMRCPROV=$PIECE(^VA(200,GMRCPROV,0),"^",1)

 +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

 +6        QUIT

 +7       ;

EXPND     ; -- expand code

 +1        QUIT

 +2       ;

GMRCEDIT.m