Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCEDIT

GMRCEDIT.m

Go to the documentation of this file.
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
 ;