- GMRCGUIC ;SLC/DCM,JFR - GUI actions for editing consults;16-Apr-2014 14:23;DU
- ;;3.0;CONSULT/REQUEST TRACKING;**4,12,20,15,22,33,1004**;DEC 27, 1997;Build 12
- ;
- ; This routine invokes IA #2398,#2698,#2713,#2960,#3991
- ;
- RFQ(GMRCO,MSG,ND,NOW) ;File Reason For Request field 20
- N GMRCND,GMRCNT
- S GMRCND=$O(^GMR(123,GMRCO,20,0)) I GMRCND="" S GMRCFLD(20)="Reason For Request: No Previous Value^20" Q
- M ^TMP("GMRCFLD20",$J,20)=^GMR(123,GMRCO,20)
- S GMRCFLD(20)=$NAME(^TMP("GMRCFLD20",$J,20))
- K ^GMR(123,GMRCO,20)
- S ^GMR(123,GMRCO,20,0)="^^^^"_DT_"^"
- S GMRCND="",GMRCNT=1 F S GMRCND=$O(@MSG@(ND,GMRCND)) Q:GMRCND="" S ^GMR(123,GMRCO,20,GMRCNT,0)=@MSG@(ND,GMRCND),GMRCNT=GMRCNT+1
- S $P(^GMR(123,GMRCO,20,0),"^",3)=GMRCNT-1,$P(^(0),"^",4)=GMRCNT-1
- Q
- FILE(GMRCO,MSG,GMRCLM) ;File Edit changes
- ;GMRCO=Record IEN, GMRCCOM=Comment Array
- ;MSG=^TMP global where the data resides, i.e., MSG="^TMP(""GMRCR"",$J)"
- ; Data is stored in subscripted nodes: ^TMP("GMRCR",$J,1)="GMRCSS^2"
- ; Word processing data is stored in second subscripted node:
- ; ^TMP("GMRCR",$J,9,1)="This is word processing data."
- ;GMRCSS=To Service GMRCPROC=procedure/Request Type
- ;GMRCURG=Urgency GMRCPL=Place Of Consultation
- ;GMRCATN=Attention To GMRCINO=Service is In/Out Patient
- ;GMRCDIAG=Provisional Diagnosis .GMRCRFQ=Reason For Request array
- ;GMRCREQ=Procedure or Request; i.e., GMRCRQT=1727=^ORD(101,1727,0)='Procedure';GMRCRQT=1296=^ORD(101,1296,0)='Consult'
- ;GMRCITM=Item ordered for field .1 (stored in ^GMR(123,GMRCO,1.11,
- ;GMRCLM=coming from List Manager instead of the GUI
- ;GMRCPRB=Associated Problem
- ;
- I '$D(GMRCO)!('+GMRCO) Q
- N GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT,GMRCPRB
- N GMRCION,GMRCDIAG,GMRCDXCD,GMRCACTN
- S GMRCDT=$$NOW^XLFDT
- S GMRCMSG="",GMRCNOD=0
- F S GMRCNOD=$O(@MSG@(GMRCNOD)) Q:GMRCNOD="" S GMRCMSG=@MSG@(GMRCNOD) D
- .I $P(GMRCMSG,"^",1)="COMMENT" D COMMENT^GMRCGUIU(GMRCO,MSG,GMRCNOD,$P(GMRCMSG,"^",2)) Q
- .I $P(GMRCMSG,"^",1)="GMRCRFQ" D RFQ(GMRCO,MSG,GMRCNOD,GMRCDT) Q
- .I $P(GMRCMSG,"^",1)="GMRCSS" S GMRCSS=$P(GMRCMSG,"^",2),GMRCFLD(1)=$P(^GMR(123.5,$P(^GMR(123,GMRCO,0),"^",5),0),"^",1)_"^1" Q
- .I $P(GMRCMSG,"^",1)="GMRCITM" S GMRCITM=$P(GMRCMSG,"^",2),GMRCFLD(.1)=^GMR(123,GMRCO,1.11)_"^.1" Q
- .I $P(GMRCMSG,"^",1)="GMRCPROC" Q ;S GMRCFLD(4)=+$P(^GMR(123,+GMRCO,0),"^",8)_"^4" D Q ;ignore procedure, can't be changed currently
- .; ..S GMRCPROC=$P(GMRCMSG,"^",2) I $L($P(^GMR(123,GMRCO,0),"^",8)),$P(GMRCMSG,"^",2)="" S GMRCPROC="DELETE"
- .I $P(GMRCMSG,"^",1)="GMRCURG" S GMRCURG=$P(GMRCMSG,"^",2),GMRCFLD(5)=$S(+$P(^GMR(123,+GMRCO,0),"^",9):$P(^ORD(101,+$P(^GMR(123,+GMRCO,0),"^",9),0),"^",2),1:"")_"^"_$P(^GMR(123,+GMRCO,0),"^",9) Q
- .I $P(GMRCMSG,"^",1)="GMRCPL" D Q
- ..S GMRCPL=$P(GMRCMSG,"^",2) I '+GMRCPL D
- ...S GMRCPL="GMRCPLACE - "_$S(GMRCPL="C":"ON CALL",GMRCPL="B":"BEDSIDE",GMRCPL="E":"EMERGENCY ROOM",1:GMRCPL),GMRCPL=$O(^ORD(101,"B",GMRCPL,0))
- ..S GMRCFLD(6)=$S(+$P(^GMR(123,+GMRCO,0),"^",10):$P($P(^ORD(101,+$P(^GMR(123,+GMRCO,0),"^",10),0),"^",1)," - ",2),1:"")_"^6"
- ..Q
- .I $P(GMRCMSG,"^",1)="GMRCATN" S GMRCATN=$P(GMRCMSG,"^",2),GMRCFLD(7)=$S(+$P(^GMR(123,+GMRCO,0),"^",11):$P(^VA(200,+$P(^GMR(123,+GMRCO,0),"^",11),0),"^",1),1:"")_"^7" Q
- .I $P(GMRCMSG,"^",1)="GMRCREQ" S GMRCREQ=$P(GMRCMSG,"^",2),GMRCFLD(13)=$S($P(^GMR(123,+GMRCO,0),"^",17)="P":"Procedure",1:"Consult")_"^13" Q
- .I $P(GMRCMSG,"^",1)="GMRCION" S GMRCION=$P(GMRCMSG,"^",2),GMRCFLD(14)=$S($P(^GMR(123,+GMRCO,0),"^",18)="I":"Inpatient",$P(^(0),"^",18)="O":"Outpatient",1:"")_"^14" Q
- .;IHS/MSC/MGH Add data for problem
- .I $P(GMRCMSG,"^",1)="GMRCDIAG" D Q
- ..S GMRCDIAG=$P(GMRCMSG,"^",2)
- ..S GMRCFLD(30)=$G(^GMR(123,+GMRCO,30))_"^30"
- ..I $P(GMRCFLD(30),U)="" S $P(GMRCFLD(30),U)="No Previous Value"
- ..I $L($P(GMRCMSG,U,4)) D
- ...S GMRCPRB=$P(GMRCMSG,"^",4)
- ...S GMRCFLD(9999999.02)=$P($G(^GMR(123,+GMRCO,9999999)),"^",2)_"^9999999.02"
- ..I $L($P(GMRCMSG,U,3)) D
- ...S GMRCDXCD=$P(GMRCMSG,"^",3)
- ...S GMRCFLD(30.1)=$G(^GMR(123,+GMRCO,30.1))
- .Q
- S:'$D(GMRCLM) GMRCGUIF=1
- S GMRCACTN=$$EN^GMRCEDT3(GMRCO)
- S DR=$$SETDA^GMRCGUIU($G(GMRCSS),$G(GMRCPROC),$G(GMRCURG),$G(GMRCPL),$G(GMRCATN),$G(GMRCRQT),$G(GMRCION),$G(GMRCDIAG),$G(GMRCDXCD),$G(GMRCPRB)) I $L(DR) D
- .S DIE="^GMR(123,",DA=GMRCO
- .L +^GMR(123,GMRCO)
- .D ^DIE
- .S DR="8////^S X=5;9////^S X=11"
- .D ^DIE
- .L -^GMR(123,GMRCO)
- .K DIE,DR,DA
- .Q
- S DFN=$P(^GMR(123,+GMRCO,0),"^",2),GMRCPROV=$P(^(0),"^",14),GMRCTYPE=$P(^(0),"^",17),GMRCTRLC="XX^RESUBMIT",VISIT="",RMBED=""
- D EN^GMRCHL7(DFN,+GMRCO,GMRCTYPE,RMBED,GMRCTRLC,$G(DUZ),VISIT,.GMRCOM)
- S GMRCSVC=$S($G(GMRCSS):GMRCSS,1:$P(^GMR(123,+GMRCO,0),U,5))
- S GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)
- S GMRCORTX=GMRCORTX_$S($G(GMRCURG):" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",+$P(^GMR(123,+GMRCO,0),U,9):"( "_$P(^ORD(101,+$P(^GMR(123,+GMRCO,0),U,9),0),"^",2)_" )",1:"")
- S GMRCFL=1
- D MSG^GMRCP(DFN,GMRCORTX,+GMRCO,27,.GMRCADUZ,GMRCFL) ;Send notification of NEW consult
- D PRNT^GMRCUTL1(+$P(^GMR(123,+GMRCO,0),U,5),+GMRCO) ;send 513 to service
- ;Next line gets rid of alert
- I $D(XQAID),$L(XQAID) D
- . N GMRCCORY
- . S XQAKILL=$$XQAKILL^ORB3F1 D DEL^ORB3FUP1(.GMRCCORY,XQAID)
- I $P($G(^GMR(123,+GMRCO,12)),U,5)="P" D
- . D TRIGR^GMRCIEVT(GMRCO,GMRCACTN)
- D GUIC^GMRCGUIU
- Q
- SEND(GMRCO,GLOBAL) ;Get data fields to send to GUI for editing consult
- ;GMRCO=record being edited GLOBAL=Global Referece, i.e., "^TMP("GMRCR",$J)"
- K @GLOBAL
- N ND,GMRCSX,TYPE,NDX,GMRCPROB
- S ND=1,GMRCSX=""
- I '$D(GMRCO)!('+GMRCO) Q
- S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:'$L(GMRC(0))
- S GMRCSS=$P(GMRC(0),"^",5),GMRCPROC=$P(GMRC(0),"^",8)
- S GMRCURG=$P(GMRC(0),"^",9),GMRCPL=$P(GMRC(0),"^",10)
- S GMRCATN=$P(GMRC(0),"^",11),GMRCINO=$P(GMRC(0),"^",18)
- S GMRCREQ=$P(GMRC(0),"^",17)
- S GMRCDIAG=$G(^GMR(123,+GMRCO,30)) I $L($G(^(30.1))) D
- . S GMRCDIAG=GMRCDIAG_U_$G(^GMR(123,+GMRCO,30.1))
- . I '$$STATCHK^ICDAPIU($P(GMRCDIAG,U,2),DT) S GMRCDIAG=GMRCDIAG_U_1
- S GMRCPROB=$P($G(^GMR(123,+GMRCO,9999999)),U,2)
- ;IHS/MSC/MGH problem added for patch 1004
- I GMRCPROB S GMRCPROB=GMRCPROB_U_$$GET1^DIQ(9000011,GMRCPROB,.01)
- S GMRCPROV=$S($P(^GMR(123,+GMRCO,0),U,14):$$GET1^DIQ(200,+$P(^(0),U,14),.01),1:"")
- S @GLOBAL@(ND,0)="~SERVICE",ND=ND+1
- I +GMRCSS S GMRCSX=$P(^GMR(123.5,GMRCSS,0),"^",1),@GLOBAL@(ND,0)="d"_GMRCSX_"^"_GMRCSS_"^",ND=ND+1,GMRCSX=""
- E S @GLOBAL@(ND,0)="d"_"^^",ND=ND+1
- S @GLOBAL@(ND,0)="~PROCEDURE",ND=ND+1
- I $L(GMRCPROC),+GMRCPROC D
- .S GMRCSX=$$UP^XLFSTR($$GET1^DIQ(123.3,+GMRCPROC,.01))
- .S GMRCSY=$$FIND1^DIC(101.43,,"QX",+GMRCPROC_";99PRC","ID")
- .I +GMRCSY D
- ..S @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX,ND=ND+1
- ..Q
- E S @GLOBAL@(ND,0)="d^^"
- S @GLOBAL@(ND,0)="~TYPE",ND=ND+1
- I $L(GMRCREQ) D I '$L(GMRCREQ) S @GLOBAL@(ND,0)="d^^"
- . S GMRCSX=$S(GMRCREQ="P":"PROCEDURE",1:"CONSULT")
- . S @GLOBAL@(ND,0)="d"_$E(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCREQ
- . S GMRCSX=""
- S ND=ND+1
- S @GLOBAL@(ND,0)="~CATEGORY",ND=ND+1
- I $L(GMRCINO) D S ND=ND+1,GMRCSX=""
- .S @GLOBAL@(ND,0)="d"_GMRCINO_"^"_$S(GMRCINO="I":"INPATIENT",1:"OUTPATIENT")_"^"
- .S @GLOBAL@(ND,0)=@GLOBAL@(ND,0)_$S(GMRCINO="I":$O(^ORD(101,"B","GMRCURGENCYM CSLT - INPATIENT",0)),1:$O(^ORD(101,"B","GMRCURGENCYM - OUTPATIENT",0)))
- .Q
- E S @GLOBAL@(ND,0)="d^^"
- S @GLOBAL@(ND,0)="~DIAGNOSIS",ND=ND+1
- I $L(GMRCDIAG) S @GLOBAL@(ND,0)="d"_GMRCDIAG,ND=ND+1
- E S @GLOBAL@(ND,0)="d^^",ND=ND+1
- S @GLOBAL@(ND,0)="~PROBLEM",ND=ND+1
- ;IHS/MSC/MGH Problem added for Patch 1004
- I GMRCPROB S @GLOBAL@(ND,0)="d"_GMRCPROB,ND=ND+1
- E S @GLOBAL@(ND,0)="d^^",ND=ND+1
- S @GLOBAL@(ND,0)="~PLACE",ND=ND+1
- I +GMRCPL D S ND=ND+1,GMRCSX=""
- .S GMRCSX=$P($P(^ORD(101,GMRCPL,0),"^",1),"GMRCPLACE - ",2),GMRCSX=$S(GMRCSX="ON CALL":"CONSULTANTS CHOICE",1:GMRCSX),@GLOBAL@(ND,0)="d"_$E(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCPL
- .Q
- E S @GLOBAL@(ND,0)="d^^",ND=ND+1
- S @GLOBAL@(ND,0)="~ATTENTION",ND=ND+1
- I +GMRCATN S GMRCSX=$P(^VA(200,GMRCATN,0),"^",1),@GLOBAL@(ND,0)="d"_GMRCATN_"^"_GMRCSX_"^"_GMRCATN,ND=ND+1,GMRCSX=""
- E S @GLOBAL@(ND,0)="d^^",ND=ND+1
- S @GLOBAL@(ND,0)="~URGENCY",ND=ND+1
- I +GMRCURG S GMRCSX=$P($P(^ORD(101,GMRCURG,0),"^",1),"GMRCURGENCY - ",2),GMRCURGY=$O(^ORD(101.42,"S.GMRCO",GMRCSX,0)) I $L(GMRCSX) D
- .S GMRCSY=$O(^ORD(101.42,"B",GMRCSX,0))
- .S @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX_"^"_GMRCURG,ND=ND+1
- .S GMRCSX="" K GMRCSY
- .Q
- E S @GLOBAL@(ND,0)="d^^",ND=ND+1
- ;Get reason for request
- S @GLOBAL@(ND,0)="~REASON",ND=ND+1
- I $O(^GMR(123,+GMRCO,20,0)) S NDX=0 F S NDX=$O(^GMR(123,+GMRCO,20,NDX)) Q:NDX="" S @GLOBAL@(ND,0)="t"_^GMR(123,+GMRCO,20,NDX,0),ND=ND+1
- E S @GLOBAL@(ND,0)="~REASON",ND=ND+1,@GLOBAL@(ND,0)="tREASON "
- ;Get Comments, including Deny Comments
- D SENDCOMT^GMRCGUIU(GMRCO,.ND)
- D GUIC^GMRCGUIU
- Q
- GMRCGUIC ;SLC/DCM,JFR - GUI actions for editing consults;16-Apr-2014 14:23;DU
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,20,15,22,33,1004**;DEC 27, 1997;Build 12
- +2 ;
- +3 ; This routine invokes IA #2398,#2698,#2713,#2960,#3991
- +4 ;
- RFQ(GMRCO,MSG,ND,NOW) ;File Reason For Request field 20
- +1 NEW GMRCND,GMRCNT
- +2 SET GMRCND=$ORDER(^GMR(123,GMRCO,20,0))
- IF GMRCND=""
- SET GMRCFLD(20)="Reason For Request: No Previous Value^20"
- QUIT
- +3 MERGE ^TMP("GMRCFLD20",$JOB,20)=^GMR(123,GMRCO,20)
- +4 SET GMRCFLD(20)=$NAME(^TMP("GMRCFLD20",$JOB,20))
- +5 KILL ^GMR(123,GMRCO,20)
- +6 SET ^GMR(123,GMRCO,20,0)="^^^^"_DT_"^"
- +7 SET GMRCND=""
- SET GMRCNT=1
- FOR
- SET GMRCND=$ORDER(@MSG@(ND,GMRCND))
- IF GMRCND=""
- QUIT
- SET ^GMR(123,GMRCO,20,GMRCNT,0)=@MSG@(ND,GMRCND)
- SET GMRCNT=GMRCNT+1
- +8 SET $PIECE(^GMR(123,GMRCO,20,0),"^",3)=GMRCNT-1
- SET $PIECE(^(0),"^",4)=GMRCNT-1
- +9 QUIT
- FILE(GMRCO,MSG,GMRCLM) ;File Edit changes
- +1 ;GMRCO=Record IEN, GMRCCOM=Comment Array
- +2 ;MSG=^TMP global where the data resides, i.e., MSG="^TMP(""GMRCR"",$J)"
- +3 ; Data is stored in subscripted nodes: ^TMP("GMRCR",$J,1)="GMRCSS^2"
- +4 ; Word processing data is stored in second subscripted node:
- +5 ; ^TMP("GMRCR",$J,9,1)="This is word processing data."
- +6 ;GMRCSS=To Service GMRCPROC=procedure/Request Type
- +7 ;GMRCURG=Urgency GMRCPL=Place Of Consultation
- +8 ;GMRCATN=Attention To GMRCINO=Service is In/Out Patient
- +9 ;GMRCDIAG=Provisional Diagnosis .GMRCRFQ=Reason For Request array
- +10 ;GMRCREQ=Procedure or Request; i.e., GMRCRQT=1727=^ORD(101,1727,0)='Procedure';GMRCRQT=1296=^ORD(101,1296,0)='Consult'
- +11 ;GMRCITM=Item ordered for field .1 (stored in ^GMR(123,GMRCO,1.11,
- +12 ;GMRCLM=coming from List Manager instead of the GUI
- +13 ;GMRCPRB=Associated Problem
- +14 ;
- +15 IF '$DATA(GMRCO)!('+GMRCO)
- QUIT
- +16 NEW GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT,GMRCPRB
- +17 NEW GMRCION,GMRCDIAG,GMRCDXCD,GMRCACTN
- +18 SET GMRCDT=$$NOW^XLFDT
- +19 SET GMRCMSG=""
- SET GMRCNOD=0
- +20 FOR
- SET GMRCNOD=$ORDER(@MSG@(GMRCNOD))
- IF GMRCNOD=""
- QUIT
- SET GMRCMSG=@MSG@(GMRCNOD)
- Begin DoDot:1
- +21 IF $PIECE(GMRCMSG,"^",1)="COMMENT"
- DO COMMENT^GMRCGUIU(GMRCO,MSG,GMRCNOD,$PIECE(GMRCMSG,"^",2))
- QUIT
- +22 IF $PIECE(GMRCMSG,"^",1)="GMRCRFQ"
- DO RFQ(GMRCO,MSG,GMRCNOD,GMRCDT)
- QUIT
- +23 IF $PIECE(GMRCMSG,"^",1)="GMRCSS"
- SET GMRCSS=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(1)=$PIECE(^GMR(123.5,$PIECE(^GMR(123,GMRCO,0),"^",5),0),"^",1)_"^1"
- QUIT
- +24 IF $PIECE(GMRCMSG,"^",1)="GMRCITM"
- SET GMRCITM=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(.1)=^GMR(123,GMRCO,1.11)_"^.1"
- QUIT
- +25 ;S GMRCFLD(4)=+$P(^GMR(123,+GMRCO,0),"^",8)_"^4" D Q ;ignore procedure, can't be changed currently
- IF $PIECE(GMRCMSG,"^",1)="GMRCPROC"
- QUIT
- +26 ; ..S GMRCPROC=$P(GMRCMSG,"^",2) I $L($P(^GMR(123,GMRCO,0),"^",8)),$P(GMRCMSG,"^",2)="" S GMRCPROC="DELETE"
- +27 IF $PIECE(GMRCMSG,"^",1)="GMRCURG"
- SET GMRCURG=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(5)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",9):$PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),"^",9),0),"^",2),1:"")_"^"_$PIECE(^GMR(123,+GMRCO,0),"^",9)
- QUIT
- +28 IF $PIECE(GMRCMSG,"^",1)="GMRCPL"
- Begin DoDot:2
- +29 SET GMRCPL=$PIECE(GMRCMSG,"^",2)
- IF '+GMRCPL
- Begin DoDot:3
- +30 SET GMRCPL="GMRCPLACE - "_$SELECT(GMRCPL="C":"ON CALL",GMRCPL="B":"BEDSIDE",GMRCPL="E":"EMERGENCY ROOM",1:GMRCPL)
- SET GMRCPL=$ORDER(^ORD(101,"B",GMRCPL,0))
- End DoDot:3
- +31 SET GMRCFLD(6)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",10):$PIECE($PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),"^",10),0),"^",1)," - ",2),1:"")_"^6"
- +32 QUIT
- End DoDot:2
- QUIT
- +33 IF $PIECE(GMRCMSG,"^",1)="GMRCATN"
- SET GMRCATN=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(7)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",11):$PIECE(^VA(200,+$PIECE(^GMR(123,+GMRCO,0),"^",11),0),"^",1),1:"")_"^7"
- QUIT
- +34 IF $PIECE(GMRCMSG,"^",1)="GMRCREQ"
- SET GMRCREQ=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(13)=$SELECT($PIECE(^GMR(123,+GMRCO,0),"^",17)="P":"Procedure",1:"Consult")_"^13"
- QUIT
- +35 IF $PIECE(GMRCMSG,"^",1)="GMRCION"
- SET GMRCION=$PIECE(GMRCMSG,"^",2)
- SET GMRCFLD(14)=$SELECT($PIECE(^GMR(123,+GMRCO,0),"^",18)="I":"Inpatient",$PIECE(^(0),"^",18)="O":"Outpatient",1:"")_"^14"
- QUIT
- +36 ;IHS/MSC/MGH Add data for problem
- +37 IF $PIECE(GMRCMSG,"^",1)="GMRCDIAG"
- Begin DoDot:2
- +38 SET GMRCDIAG=$PIECE(GMRCMSG,"^",2)
- +39 SET GMRCFLD(30)=$GET(^GMR(123,+GMRCO,30))_"^30"
- +40 IF $PIECE(GMRCFLD(30),U)=""
- SET $PIECE(GMRCFLD(30),U)="No Previous Value"
- +41 IF $LENGTH($PIECE(GMRCMSG,U,4))
- Begin DoDot:3
- +42 SET GMRCPRB=$PIECE(GMRCMSG,"^",4)
- +43 SET GMRCFLD(9999999.02)=$PIECE($GET(^GMR(123,+GMRCO,9999999)),"^",2)_"^9999999.02"
- End DoDot:3
- +44 IF $LENGTH($PIECE(GMRCMSG,U,3))
- Begin DoDot:3
- +45 SET GMRCDXCD=$PIECE(GMRCMSG,"^",3)
- +46 SET GMRCFLD(30.1)=$GET(^GMR(123,+GMRCO,30.1))
- End DoDot:3
- End DoDot:2
- QUIT
- +47 QUIT
- End DoDot:1
- +48 IF '$DATA(GMRCLM)
- SET GMRCGUIF=1
- +49 SET GMRCACTN=$$EN^GMRCEDT3(GMRCO)
- +50 SET DR=$$SETDA^GMRCGUIU($GET(GMRCSS),$GET(GMRCPROC),$GET(GMRCURG),$GET(GMRCPL),$GET(GMRCATN),$GET(GMRCRQT),$GET(GMRCION),$GET(GMRCDIAG),$GET(GMRCDXCD),$GET(GMRCPRB))
- IF $LENGTH(DR)
- Begin DoDot:1
- +51 SET DIE="^GMR(123,"
- SET DA=GMRCO
- +52 LOCK +^GMR(123,GMRCO)
- +53 DO ^DIE
- +54 SET DR="8////^S X=5;9////^S X=11"
- +55 DO ^DIE
- +56 LOCK -^GMR(123,GMRCO)
- +57 KILL DIE,DR,DA
- +58 QUIT
- End DoDot:1
- +59 SET DFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
- SET GMRCPROV=$PIECE(^(0),"^",14)
- SET GMRCTYPE=$PIECE(^(0),"^",17)
- SET GMRCTRLC="XX^RESUBMIT"
- SET VISIT=""
- SET RMBED=""
- +60 DO EN^GMRCHL7(DFN,+GMRCO,GMRCTYPE,RMBED,GMRCTRLC,$GET(DUZ),VISIT,.GMRCOM)
- +61 SET GMRCSVC=$SELECT($GET(GMRCSS):GMRCSS,1:$PIECE(^GMR(123,+GMRCO,0),U,5))
- +62 SET GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)
- +63 SET GMRCORTX=GMRCORTX_$SELECT($GET(GMRCURG):" ("_$PIECE(^ORD(101,+GMRCURG,0),"^",2)_")",+$PIECE(^GMR(123,+GMRCO,0),U,9):"( "_$PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),U,9),0),"^",2)_" )",1:"")
- +64 SET GMRCFL=1
- +65 ;Send notification of NEW consult
- DO MSG^GMRCP(DFN,GMRCORTX,+GMRCO,27,.GMRCADUZ,GMRCFL)
- +66 ;send 513 to service
- DO PRNT^GMRCUTL1(+$PIECE(^GMR(123,+GMRCO,0),U,5),+GMRCO)
- +67 ;Next line gets rid of alert
- +68 IF $DATA(XQAID)
- IF $LENGTH(XQAID)
- Begin DoDot:1
- +69 NEW GMRCCORY
- +70 SET XQAKILL=$$XQAKILL^ORB3F1
- DO DEL^ORB3FUP1(.GMRCCORY,XQAID)
- End DoDot:1
- +71 IF $PIECE($GET(^GMR(123,+GMRCO,12)),U,5)="P"
- Begin DoDot:1
- +72 DO TRIGR^GMRCIEVT(GMRCO,GMRCACTN)
- End DoDot:1
- +73 DO GUIC^GMRCGUIU
- +74 QUIT
- SEND(GMRCO,GLOBAL) ;Get data fields to send to GUI for editing consult
- +1 ;GMRCO=record being edited GLOBAL=Global Referece, i.e., "^TMP("GMRCR",$J)"
- +2 KILL @GLOBAL
- +3 NEW ND,GMRCSX,TYPE,NDX,GMRCPROB
- +4 SET ND=1
- SET GMRCSX=""
- +5 IF '$DATA(GMRCO)!('+GMRCO)
- QUIT
- +6 SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))
- IF '$LENGTH(GMRC(0))
- QUIT
- +7 SET GMRCSS=$PIECE(GMRC(0),"^",5)
- SET GMRCPROC=$PIECE(GMRC(0),"^",8)
- +8 SET GMRCURG=$PIECE(GMRC(0),"^",9)
- SET GMRCPL=$PIECE(GMRC(0),"^",10)
- +9 SET GMRCATN=$PIECE(GMRC(0),"^",11)
- SET GMRCINO=$PIECE(GMRC(0),"^",18)
- +10 SET GMRCREQ=$PIECE(GMRC(0),"^",17)
- +11 SET GMRCDIAG=$GET(^GMR(123,+GMRCO,30))
- IF $LENGTH($GET(^(30.1)))
- Begin DoDot:1
- +12 SET GMRCDIAG=GMRCDIAG_U_$GET(^GMR(123,+GMRCO,30.1))
- +13 IF '$$STATCHK^ICDAPIU($PIECE(GMRCDIAG,U,2),DT)
- SET GMRCDIAG=GMRCDIAG_U_1
- End DoDot:1
- +14 SET GMRCPROB=$PIECE($GET(^GMR(123,+GMRCO,9999999)),U,2)
- +15 ;IHS/MSC/MGH problem added for patch 1004
- +16 IF GMRCPROB
- SET GMRCPROB=GMRCPROB_U_$$GET1^DIQ(9000011,GMRCPROB,.01)
- +17 SET GMRCPROV=$SELECT($PIECE(^GMR(123,+GMRCO,0),U,14):$$GET1^DIQ(200,+$PIECE(^(0),U,14),.01),1:"")
- +18 SET @GLOBAL@(ND,0)="~SERVICE"
- SET ND=ND+1
- +19 IF +GMRCSS
- SET GMRCSX=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
- SET @GLOBAL@(ND,0)="d"_GMRCSX_"^"_GMRCSS_"^"
- SET ND=ND+1
- SET GMRCSX=""
- +20 IF '$TEST
- SET @GLOBAL@(ND,0)="d"_"^^"
- SET ND=ND+1
- +21 SET @GLOBAL@(ND,0)="~PROCEDURE"
- SET ND=ND+1
- +22 IF $LENGTH(GMRCPROC)
- IF +GMRCPROC
- Begin DoDot:1
- +23 SET GMRCSX=$$UP^XLFSTR($$GET1^DIQ(123.3,+GMRCPROC,.01))
- +24 SET GMRCSY=$$FIND1^DIC(101.43,,"QX",+GMRCPROC_";99PRC","ID")
- +25 IF +GMRCSY
- Begin DoDot:2
- +26 SET @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX
- SET ND=ND+1
- +27 QUIT
- End DoDot:2
- End DoDot:1
- +28 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- +29 SET @GLOBAL@(ND,0)="~TYPE"
- SET ND=ND+1
- +30 IF $LENGTH(GMRCREQ)
- Begin DoDot:1
- +31 SET GMRCSX=$SELECT(GMRCREQ="P":"PROCEDURE",1:"CONSULT")
- +32 SET @GLOBAL@(ND,0)="d"_$EXTRACT(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCREQ
- +33 SET GMRCSX=""
- End DoDot:1
- IF '$LENGTH(GMRCREQ)
- SET @GLOBAL@(ND,0)="d^^"
- +34 SET ND=ND+1
- +35 SET @GLOBAL@(ND,0)="~CATEGORY"
- SET ND=ND+1
- +36 IF $LENGTH(GMRCINO)
- Begin DoDot:1
- +37 SET @GLOBAL@(ND,0)="d"_GMRCINO_"^"_$SELECT(GMRCINO="I":"INPATIENT",1:"OUTPATIENT")_"^"
- +38 SET @GLOBAL@(ND,0)=@GLOBAL@(ND,0)_$SELECT(GMRCINO="I":$ORDER(^ORD(101,"B","GMRCURGENCYM CSLT - INPATIENT",0)),1:$ORDER(^ORD(101,"B","GMRCURGENCYM - OUTPATIENT",0)))
- +39 QUIT
- End DoDot:1
- SET ND=ND+1
- SET GMRCSX=""
- +40 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- +41 SET @GLOBAL@(ND,0)="~DIAGNOSIS"
- SET ND=ND+1
- +42 IF $LENGTH(GMRCDIAG)
- SET @GLOBAL@(ND,0)="d"_GMRCDIAG
- SET ND=ND+1
- +43 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- SET ND=ND+1
- +44 SET @GLOBAL@(ND,0)="~PROBLEM"
- SET ND=ND+1
- +45 ;IHS/MSC/MGH Problem added for Patch 1004
- +46 IF GMRCPROB
- SET @GLOBAL@(ND,0)="d"_GMRCPROB
- SET ND=ND+1
- +47 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- SET ND=ND+1
- +48 SET @GLOBAL@(ND,0)="~PLACE"
- SET ND=ND+1
- +49 IF +GMRCPL
- Begin DoDot:1
- +50 SET GMRCSX=$PIECE($PIECE(^ORD(101,GMRCPL,0),"^",1),"GMRCPLACE - ",2)
- SET GMRCSX=$SELECT(GMRCSX="ON CALL":"CONSULTANTS CHOICE",1:GMRCSX)
- SET @GLOBAL@(ND,0)="d"_$EXTRACT(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCPL
- +51 QUIT
- End DoDot:1
- SET ND=ND+1
- SET GMRCSX=""
- +52 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- SET ND=ND+1
- +53 SET @GLOBAL@(ND,0)="~ATTENTION"
- SET ND=ND+1
- +54 IF +GMRCATN
- SET GMRCSX=$PIECE(^VA(200,GMRCATN,0),"^",1)
- SET @GLOBAL@(ND,0)="d"_GMRCATN_"^"_GMRCSX_"^"_GMRCATN
- SET ND=ND+1
- SET GMRCSX=""
- +55 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- SET ND=ND+1
- +56 SET @GLOBAL@(ND,0)="~URGENCY"
- SET ND=ND+1
- +57 IF +GMRCURG
- SET GMRCSX=$PIECE($PIECE(^ORD(101,GMRCURG,0),"^",1),"GMRCURGENCY - ",2)
- SET GMRCURGY=$ORDER(^ORD(101.42,"S.GMRCO",GMRCSX,0))
- IF $LENGTH(GMRCSX)
- Begin DoDot:1
- +58 SET GMRCSY=$ORDER(^ORD(101.42,"B",GMRCSX,0))
- +59 SET @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX_"^"_GMRCURG
- SET ND=ND+1
- +60 SET GMRCSX=""
- KILL GMRCSY
- +61 QUIT
- End DoDot:1
- +62 IF '$TEST
- SET @GLOBAL@(ND,0)="d^^"
- SET ND=ND+1
- +63 ;Get reason for request
- +64 SET @GLOBAL@(ND,0)="~REASON"
- SET ND=ND+1
- +65 IF $ORDER(^GMR(123,+GMRCO,20,0))
- SET NDX=0
- FOR
- SET NDX=$ORDER(^GMR(123,+GMRCO,20,NDX))
- IF NDX=""
- QUIT
- SET @GLOBAL@(ND,0)="t"_^GMR(123,+GMRCO,20,NDX,0)
- SET ND=ND+1
- +66 IF '$TEST
- SET @GLOBAL@(ND,0)="~REASON"
- SET ND=ND+1
- SET @GLOBAL@(ND,0)="tREASON "
- +67 ;Get Comments, including Deny Comments
- +68 DO SENDCOMT^GMRCGUIU(GMRCO,.ND)
- +69 DO GUIC^GMRCGUIU
- +70 QUIT
