- GMRCA1 ;SLC/DLT,DCM - Actions taken from Review Screens ; 7/11/03 14:05
- ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,18,35**;DEC 27, 1997
- ; Patch 18 addS the option to Edit/Resubmit a canceled consult
- ; This routine invokes IA #867,#2424
- ;
- DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
- ;GMRCO = File 123 IEN of consult
- ;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
- ;GMRCOM=comments array
- I '$G(GMRCA) D Q
- . S GMRCMSG="This Action not defined!"
- . D EXAC^GMRCADC(GMRCMSG)
- . D END
- . S GMRCQUT=1
- K GMRCQUT,GMRCQIT
- D DC^GMRCADC(GMRCO,GMRCA)
- D END
- Q
- ;
- N GMRCA,GMRCLCK
- K GMRCQUT,GMRCQIT
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
- I '+$G(GMRCO) D END S GMRCQUT=1 Q
- I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
- S GMRCLCK=1
- D COMMENT^GMRCACMT(+GMRCO)
- D END
- Q
- ;
- EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
- N GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
- K GMRCQUT,GMRCQIT
- S XQORM("M")=3
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
- I '+$G(GMRCO) D END S GMRCQUT=1 Q
- ;
- ; Check to see if Provider or Update user is doing Edit/Resubmit
- I '$$VALPROV^GMRCEDIT(GMRCO) D
- .S GMRCMSG="0^You are not the provider of this Consult or a Update User"
- I $P(^GMR(123,GMRCO,0),"^",12)'=13 D ; If not a canceled Consult
- . S GMRCMSG="0^This consult is no longer editable."
- I $D(GMRCMSG) D EXAC^GMRCADC($P(GMRCMSG,"^",2)) D END S GMRCQUT=1 Q
- I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
- S GMRCLCK=1
- S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2) ; Get patient DFN
- I $D(GMRCQUT) Q
- D EN^GMRCEDIT(GMRCO,","_+GMRCDFN) ; Bring up Edit & Resubmit screen.
- D END
- Q
- ;
- RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
- ; GMRCSCH=1 - schedule action
- K GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
- I '+$G(GMRCO) D END S GMRCQUT=1 Q
- I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
- . N DIR
- . W !,"The requesting facility may not take this action on an "
- . W "inter-facility consult."
- . S DIR(0)="E" D ^DIR
- . D END
- . S GMRCQUT=1
- I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
- ;
- N GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
- S GMRCLCK=1
- S GMRC(0)=^GMR(123,GMRCO,0)
- S DFN=$P(GMRC(0),"^",2)
- I $S($P(GMRC(0),"^",12)=2:1,$P(^(0),"^",12)=1:1,$P(^(0),"^",12)=13:1,1:0) D S GMRCQUT=1 D END Q
- .S GMRCMSG="This consult has already been "_$S($P(GMRC(0),"^",12)=2:"Completed",$P(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
- .S GMRCMSG(1)=" This action may not be taken now."
- .D EXAC^GMRCADC(GMRCMSG)
- .K GMRCMSG
- .Q
- ;I $P(^GMR(123.5,$P(GMRC(0),"^",5),0),"^",2)=9 S GMRCMSG=$P(^(0),"^",1)_" is an INACTIVE service. No Receive action is possible",GMRCMSG(1)="for this consult on this Service!" D EXAC^GMRCADC(.GMRCMSG),END S GMRCQUT=1 Q
- I '$G(GMRCSCH),$P(GMRC(0),"^",12)'=5 D Q
- . S GMRCMSG="The receive action may only be taken when the consult"
- . S GMRCMSG=GMRCMSG_" has a pending status."
- . D EXAC^GMRCADC(GMRCMSG),END
- . S GMRCQUT=1
- I $G(GMRCSCH),"56"'[$P(GMRC(0),"^",12) D Q
- . S GMRCMSG="This consult may not be scheduled with the current status"
- . D EXAC^GMRCADC(GMRCMSG),END
- . S GMRCQUT=1
- ;
- I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
- N GETPROV
- S GETPROV=$S($G(GMRCSCH):"Who scheduled it?",1:"Who received it?")
- D GETPROV^GMRCAU K GETPROV I $D(GMRCQIT) D END S GMRCQIT="Q",GMRCQUT=1 Q
- I '$G(GMRCSCH) S GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
- I $G(GMRCSCH) S GMRCAD=$$NOW^XLFDT
- I GMRCAD="^" D Q
- . W !,$C(7) D EXAC^GMRCADC("Consult not updated with Received action.")
- . D END
- . S GMRCQUT=1
- ;The activity date is stored in GMRCAD
- I '$G(GMRCSCH) D
- . S GMRCA=21 ;for "Received"
- . I $P(GMRC(0),"^",12)=5 S GMRCSTS=6,$P(GMRC(0),"^",12)=GMRCSTS
- . E S GMRCSTS=$P(GMRC(0),"^",12)
- I $G(GMRCSCH) S GMRCA=8,GMRCSTS=8
- D STATUS^GMRCP
- S GMRCOM=1 D AUDIT^GMRCP
- D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCWARD),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
- I $G(GMRCSCH),$P(GMRCOM,U,2)=1 D
- . N TXT S TXT="Scheduled Consult: "
- . D PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
- D END
- Q
- ;
- RT(GMRCO) ;Results Display logic
- K GMRCQUT,GMRCQIT
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
- I '+$G(GMRCO) D END S GMRCQUT=1 Q
- D RT^GMRCART(GMRCO)
- D END
- Q
- ;
- PS(GMRCO) ;Print Service Copy (CPRS entry point)
- K GMRCQUT,GMRCQIT,GMRCSEL
- I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
- I '+$G(GMRCO) D END S GMRCQUT=1 Q
- S GMRC(0)=^GMR(123,GMRCO,0)
- D EN^GMRCP5(GMRCO)
- D END
- Q
- ;
- END ;kill off variables and exit
- I $G(GMRCLCK) D UNLOCK(GMRCO)
- I '$D(GMRC("NMBR")) K GMRCSEL,GMRCO
- K GMRC(0),GMRCA,GMRCACTM,GMRCAGN,GMRCDFN,GMRCENTR,GMRCFL,GMRCIEN,GMRCMSG,GMRCOM,GMRCO,GMRCORFN,GMRCORN,GMRCORTX,GMRCRTFL,GMRCSEL,GMRCSTS,GMRCTRLC,GMRCEND,GMRCSA,GMRCSR,GMRCBM,GMRCTM,GMRCADUZ,ORIFN,OREND,SF,STS
- I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
- K DTOUT,DIROUT,DUOUT
- S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
- Q
- LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
- N GMRCORD,GMRCLOCK
- S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD 1
- S GMRCLOCK=$$LOCK1^ORX2(GMRCORD) I +GMRCLOCK Q 1
- ;Q:$G(GMRCGUI)
- D EXAC^GMRCADC($P(GMRCLOCK,U,2))
- Q 0
- UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
- N GMRCORD
- S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD
- D UNLK1^ORX2(GMRCORD)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCA1 5448 printed Jan 18, 2025@02:46:07 Page 2
- GMRCA1 ;SLC/DLT,DCM - Actions taken from Review Screens ; 7/11/03 14:05
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,18,35**;DEC 27, 1997
- +2 ; Patch 18 addS the option to Edit/Resubmit a canceled consult
- +3 ; This routine invokes IA #867,#2424
- +4 ;
- DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
- +1 ;GMRCO = File 123 IEN of consult
- +2 ;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
- +3 ;GMRCOM=comments array
- +4 IF '$GET(GMRCA)
- Begin DoDot:1
- +5 SET GMRCMSG="This Action not defined!"
- +6 DO EXAC^GMRCADC(GMRCMSG)
- +7 DO END
- +8 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +9 KILL GMRCQUT,GMRCQIT
- +10 DO DC^GMRCADC(GMRCO,GMRCA)
- +11 DO END
- +12 QUIT
- +13 ;
- +1 NEW GMRCA,GMRCLCK
- +2 KILL GMRCQUT,GMRCQIT
- +3 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- DO END
- QUIT
- +4 IF '+$GET(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +5 IF '$$LOCK(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +6 SET GMRCLCK=1
- +7 DO COMMENT^GMRCACMT(+GMRCO)
- +8 DO END
- +9 QUIT
- +10 ;
- EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
- +1 NEW GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
- +2 KILL GMRCQUT,GMRCQIT
- +3 SET XQORM("M")=3
- +4 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- DO END
- QUIT
- +5 IF '+$GET(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +6 ;
- +7 ; Check to see if Provider or Update user is doing Edit/Resubmit
- +8 IF '$$VALPROV^GMRCEDIT(GMRCO)
- Begin DoDot:1
- +9 SET GMRCMSG="0^You are not the provider of this Consult or a Update User"
- End DoDot:1
- +10 ; If not a canceled Consult
- IF $PIECE(^GMR(123,GMRCO,0),"^",12)'=13
- Begin DoDot:1
- +11 SET GMRCMSG="0^This consult is no longer editable."
- End DoDot:1
- +12 IF $DATA(GMRCMSG)
- DO EXAC^GMRCADC($PIECE(GMRCMSG,"^",2))
- DO END
- SET GMRCQUT=1
- QUIT
- +13 IF '$$LOCK(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +14 SET GMRCLCK=1
- +15 ; Get patient DFN
- SET GMRCDFN=$PIECE(^GMR(123,GMRCO,0),"^",2)
- +16 IF $DATA(GMRCQUT)
- QUIT
- +17 ; Bring up Edit & Resubmit screen.
- DO EN^GMRCEDIT(GMRCO,","_+GMRCDFN)
- +18 DO END
- +19 QUIT
- +20 ;
- RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
- +1 ; GMRCSCH=1 - schedule action
- +2 KILL GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
- +3 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- DO END
- QUIT
- +4 IF '+$GET(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +5 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
- Begin DoDot:1
- +6 NEW DIR
- +7 WRITE !,"The requesting facility may not take this action on an "
- +8 WRITE "inter-facility consult."
- +9 SET DIR(0)="E"
- DO ^DIR
- +10 DO END
- +11 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +12 IF '$$LOCK(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +13 ;
- +14 NEW GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
- +15 SET GMRCLCK=1
- +16 SET GMRC(0)=^GMR(123,GMRCO,0)
- +17 SET DFN=$PIECE(GMRC(0),"^",2)
- +18 IF $SELECT($PIECE(GMRC(0),"^",12)=2:1,$PIECE(^(0),"^",12)=1:1,$PIECE(^(0),"^",12)=13:1,1:0)
- Begin DoDot:1
- +19 SET GMRCMSG="This consult has already been "_$SELECT($PIECE(GMRC(0),"^",12)=2:"Completed",$PIECE(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
- +20 SET GMRCMSG(1)=" This action may not be taken now."
- +21 DO EXAC^GMRCADC(GMRCMSG)
- +22 KILL GMRCMSG
- +23 QUIT
- End DoDot:1
- SET GMRCQUT=1
- DO END
- QUIT
- +24 ;I $P(^GMR(123.5,$P(GMRC(0),"^",5),0),"^",2)=9 S GMRCMSG=$P(^(0),"^",1)_" is an INACTIVE service. No Receive action is possible",GMRCMSG(1)="for this consult on this Service!" D EXAC^GMRCADC(.GMRCMSG),END S GMRCQUT=1 Q
- +25 IF '$GET(GMRCSCH)
- IF $PIECE(GMRC(0),"^",12)'=5
- Begin DoDot:1
- +26 SET GMRCMSG="The receive action may only be taken when the consult"
- +27 SET GMRCMSG=GMRCMSG_" has a pending status."
- +28 DO EXAC^GMRCADC(GMRCMSG)
- DO END
- +29 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +30 IF $GET(GMRCSCH)
- IF "56"'[$PIECE(GMRC(0),"^",12)
- Begin DoDot:1
- +31 SET GMRCMSG="This consult may not be scheduled with the current status"
- +32 DO EXAC^GMRCADC(GMRCMSG)
- DO END
- +33 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +34 ;
- +35 IF $DATA(IOTM)
- IF $DATA(IOBM)
- IF $DATA(IOSTBM)
- DO FULL^VALM1
- +36 NEW GETPROV
- +37 SET GETPROV=$SELECT($GET(GMRCSCH):"Who scheduled it?",1:"Who received it?")
- +38 DO GETPROV^GMRCAU
- KILL GETPROV
- IF $DATA(GMRCQIT)
- DO END
- SET GMRCQIT="Q"
- SET GMRCQUT=1
- QUIT
- +39 IF '$GET(GMRCSCH)
- SET GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
- +40 IF $GET(GMRCSCH)
- SET GMRCAD=$$NOW^XLFDT
- +41 IF GMRCAD="^"
- Begin DoDot:1
- +42 WRITE !,$CHAR(7)
- DO EXAC^GMRCADC("Consult not updated with Received action.")
- +43 DO END
- +44 SET GMRCQUT=1
- End DoDot:1
- QUIT
- +45 ;The activity date is stored in GMRCAD
- +46 IF '$GET(GMRCSCH)
- Begin DoDot:1
- +47 ;for "Received"
- SET GMRCA=21
- +48 IF $PIECE(GMRC(0),"^",12)=5
- SET GMRCSTS=6
- SET $PIECE(GMRC(0),"^",12)=GMRCSTS
- +49 IF '$TEST
- SET GMRCSTS=$PIECE(GMRC(0),"^",12)
- End DoDot:1
- +50 IF $GET(GMRCSCH)
- SET GMRCA=8
- SET GMRCSTS=8
- +51 DO STATUS^GMRCP
- +52 SET GMRCOM=1
- DO AUDIT^GMRCP
- +53 DO EN^GMRCHL7(DFN,GMRCO,$GET(GMRCTYPE),$GET(GMRCWARD),"SC",GMRCORNP,$GET(GMRCVSIT),.GMRCOM,,$GET(GMRCAD))
- +54 IF $GET(GMRCSCH)
- IF $PIECE(GMRCOM,U,2)=1
- Begin DoDot:1
- +55 NEW TXT
- SET TXT="Scheduled Consult: "
- +56 DO PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
- End DoDot:1
- +57 DO END
- +58 QUIT
- +59 ;
- RT(GMRCO) ;Results Display logic
- +1 KILL GMRCQUT,GMRCQIT
- +2 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- DO END
- QUIT
- +3 IF '+$GET(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +4 DO RT^GMRCART(GMRCO)
- +5 DO END
- +6 QUIT
- +7 ;
- PS(GMRCO) ;Print Service Copy (CPRS entry point)
- +1 KILL GMRCQUT,GMRCQIT,GMRCSEL
- +2 IF '+$GET(GMRCO)
- DO SELECT^GMRCA2(.GMRCO)
- IF $DATA(GMRCQUT)
- DO END
- QUIT
- +3 IF '+$GET(GMRCO)
- DO END
- SET GMRCQUT=1
- QUIT
- +4 SET GMRC(0)=^GMR(123,GMRCO,0)
- +5 DO EN^GMRCP5(GMRCO)
- +6 DO END
- +7 QUIT
- +8 ;
- END ;kill off variables and exit
- +1 IF $GET(GMRCLCK)
- DO UNLOCK(GMRCO)
- +2 IF '$DATA(GMRC("NMBR"))
- KILL GMRCSEL,GMRCO
- +3 KILL GMRC(0),GMRCA,GMRCACTM,GMRCAGN,GMRCDFN,GMRCENTR,GMRCFL,GMRCIEN,GMRCMSG,GMRCOM,GMRCO,GMRCORFN,GMRCORN,GMRCORTX,GMRCRTFL,GMRCSEL,GMRCSTS,GMRCTRLC,GMRCEND,GMRCSA,GMRCSR,GMRCBM,GMRCTM,GMRCADUZ,ORIFN,OREND,SF,STS
- +4 IF $DATA(DTOUT)!$DATA(DIROUT)
- SET GMRCQIT=""
- +5 KILL DTOUT,DIROUT,DUOUT
- +6 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
- SET XQORM("HIJACK")=^("MENU")
- +7 QUIT
- LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
- +1 NEW GMRCORD,GMRCLOCK
- +2 SET GMRCORD=$PIECE($GET(^GMR(123,GMRCIFN,0)),U,3)
- if 'GMRCORD
- QUIT 1
- +3 SET GMRCLOCK=$$LOCK1^ORX2(GMRCORD)
- IF +GMRCLOCK
- QUIT 1
- +4 ;Q:$G(GMRCGUI)
- +5 DO EXAC^GMRCADC($PIECE(GMRCLOCK,U,2))
- +6 QUIT 0
- UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
- +1 NEW GMRCORD
- +2 SET GMRCORD=$PIECE($GET(^GMR(123,GMRCIFN,0)),U,3)
- if 'GMRCORD
- QUIT
- +3 DO UNLK1^ORX2(GMRCORD)
- +4 QUIT