GMRCGUIB ;SLC/DCM,JFR,MA/AFS,PB - GUI actions for consults ; Jan 17, 2024@13:17
;;3.0;CONSULT/REQUEST TRACKING;**4,12,18,20,17,22,29,30,35,45,53,55,64,46,75,86,90,91,99,168,196**;DEC 27, 1997;Build 3
;
; Reference to MEDLKUP^MCARUTL3 in ICR #3280
; Reference to POST^HMPEVNT in ICR #6755
;
; Deprecated HCP interface via GMRC*3.0*196
;
SETDA() ;set DA of where audit actions are to be filed
S:'$D(^GMR(123,+GMRCO,40,0)) ^GMR(123,GMRCO,40,0)="^123.02DA^^"
S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
Q DA
REASON(GMRCFN,GMRCRQ,GMRCDT) ;Load the reason for the request into ^GMR(123,GMRCO,20
;GMRCFN=File 123 IFN; GMRCRQ=Array containing Reason For Request
;GMRCDT=Date time of entry
S ^GMR(123,GMRCFN,20,0)="^^^"_GMRCDT_"^"
S L=0,LN=1 F S L=$O(GMRCRQ(L)) Q:L="" S GMRCRQ(L)=$$CHKTXT^GMRCHL7U(GMRCRQ(L)),^GMR(123,GMRCFN,20,LN,0)=GMRCRQ(L),LN=LN+1
S LN=LN-1,$P(^GMR(123,GMRCFN,20,0),"^",3)=LN
K LN,L
Q
SETCOM(COMMENT,WHO) ;Set comment array into tracking actions
N GMRCNOW,DR,DIE,L
S L=0 F S L=$O(COMMENT(L)) Q:L="" S COMMENT(L)=$$CHKTXT^GMRCHL7U(COMMENT(L))
S GMRCNOW=$$NOW^XLFDT
I $P($G(^GMR(123,+GMRCO,0)),"^",11)=$G(GMRCPA) S GMRCPA=""
S DIE="^GMR(123,GMRCO,40,",DA(1)=GMRCO,DR=".01////^S X=GMRCNOW;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=$G(GMRCORNP);4////^S X=$S($G(WHO):WHO,1:DUZ);6////^S X=$G(GMRCFR);8////^S X=$G(GMRCFF);7////^S X=$G(GMRCPA)"
D ^DIE
S ^GMR(123,GMRCO,40,DA,1,0)="^^^^"_GMRCAD_"^"
S (GMRCND,GMRCND1)=0 F S GMRCND1=$O(COMMENT(GMRCND1)) Q:GMRCND1="" S GMRCND=GMRCND+1,^GMR(123,GMRCO,40,DA,1,GMRCND,0)=COMMENT(GMRCND)
S $P(^GMR(123,GMRCO,40,DA,1,0),"^",3)=GMRCND,$P(^(0),"^",4)=GMRCND,^GMR(123,GMRCO,40,"B",GMRCNOW,DA)=""
D:$D(^GMR(123,+GMRCO,0)) AG123S1^GMRCXR(+GMRCO) ;alb/sat 86 - update AG xref
;
; if an IFC, call event handler to generate a msg to remote site
I $D(^GMR(123,+GMRCO,12)),$D(^(40,DA)) D TRIGR^GMRCIEVT(GMRCO,DA)
;
K GMRCND,GMRCND1
Q
CMT(GMRCO,GMRCOM,GMRCADUZ,GMRCWHN,GMRCWHO) ;add comment to consult
; GMRCO = IEN from file 123
; GMRCOM = array of comments in format GMRCOM(1)="xxxx", GMRCOM(2)="xxx"
; GMRCADUZ = array of alert recipients as GMRCADUZ(DUZ)="" (optional)
; GMRCWHO = IEN from file 200 who's responsible activity (optional)
; GMRCWHN = date time of activity in FM format
; GMRCFORC = copy of GMRCADUZ; these users will recieve alert 63 even if alert is turned OFF; optional argument to MSG^GMRCP
;
N DA,GMRCA,GMRCAD,GMRCORTX,GMRCDFN,GMRCTM,GMRCRP,GMRCUPD,GMRCFORC
M GMRCFORC=GMRCADUZ
S DA=$$SETDA ; get next activity tracking entry
S GMRCA=20,GMRCAD=GMRCWHN S:$G(GMRCWHO) GMRCORNP=GMRCWHO
D SETCOM(.GMRCOM,$G(GMRCWHO))
;if a Non VA Care consult, notify HCP of the comment
;I $$FEE^GMRCHL7H($$GET1^DIQ(123,+GMRCO,1,"I")) D COMMENT^GMRCHL7H(+GMRCO) ;p196 Deprecated
I $$FEE^GMRCHL7H($$GET1^DIQ(123,+GMRCO,1,"I")) Q ;p196 Deprecated
;if a Non VA Care consult, notify CCRA of the comment
I $$FEE^GMRCCCRA($$GET1^DIQ(123,+GMRCO,1,"I")) D COMMENT^GMRCCCRA(+GMRCO) ;patch 99 to send to CCRA
D ;update LAST ACTION field even though no status change
. N GMRCDR,GMRCSTS
. S GMRCSTS="",GMRCDR="9////20"
. D STATUS^GMRCP
S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
S GMRCORTX="Comment Added to Consult "
D POST^HMPEVNT(GMRCDFN,"consult",GMRCO,"") ; DE6745 PB - Added to make a call to HMP to sync the patient comments
I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
. S GMRCORTX="Comment Added to remote consult "
S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
S GMRCRP=+$P(^GMR(123,GMRCO,0),U,14)
S GMRCUPD=$$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
I GMRCRP=DUZ D ;alert team if ord. prov. takes the action
. S GMRCTM=1
I GMRCUPD>1,GMRCRP'=DUZ D ; alert ord. prov if update users takes action
. S GMRCADUZ(GMRCRP)=""
I '$G(GMRCTM),GMRCUPD<2 D ;alert both if not ord. prov or update user
. S GMRCTM=1,GMRCADUZ(GMRCRP)=""
D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,63,.GMRCADUZ,$G(GMRCTM),.GMRCFORC)
Q
SFILE(GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD) ;Process various file update functions from the GUI for a consult
; ADMIN COMPLETE or SIGNIFICANT FINDINGS
;Input variables:
;GMRCO=File 123 IEN of the consult record
;GMRCA=pointer to REQUEST ACTION TYPES (#123.1) 10=complete, 4=Sig find.
;GMRCSF=Significant Findings flag: 'Y'= significant finding
; : 'N'= no significant finding
; : 'U'=unknown significant finding
;GMRCORNP=Provider Responsible for action
;GMRCDUZ=Person actually doing the action
;GMRCOM=An array of comments by reference ARRAY(1)="xxx",ARRAY(2)="xxx"
;GMRCALF=Flag to signal that alerts are to be sent; 'N'=NO, 'Y'=YES
;GMRCATO=Who alerts are to be sent to; a comma delimited string of DUZ's
;GMRCAD =FM date/time of activity
;
;Output:
; GMRCERR=Error Flag: 0 if no error, 1 if error occurred
; GMRCERMS - Error message or null
; returned as GMRCERR^GMRCERMS
;
N GMRCERR,GMRCERMS,GMRCTM
L +^GMR(123,GMRCO):5 I '$T S GMRCERR=1,GMRCERMS="Record Locked. File Update Not Accomplished." Q GMRCERR_"^"_GMRCERMS
S GMRCERR=0,GMRCTM=0,GMRCERMS="",DR="",GMRCORTX=""
N GMRCADUZ S GMRCADUZ=""
S GMRCNOW=$$NOW^XLFDT,GMRCSTS=$P(^GMR(123,+GMRCO,0),"^",12),GMRCDFN=$P(^(0),"^",2)
I '$G(GMRCDUZ) S GMRCDUZ=DUZ
I '$G(GMRCAD) S GMRCAD=GMRCNOW
;Insure comment array contains text for Complete action.
I GMRCA=10 D I GMRCERR=1 S GMRCERMS="Comment field must contain a text value!" Q GMRCERR_"^"_GMRCERMS
. S GMRCERR=1
. I '$D(GMRCOM) Q
. N GMRCOM1 S GMRCOM1=""
. F S GMRCOM1=$O(GMRCOM(GMRCOM1)) Q:(GMRCOM1=""!(GMRCERR=0)) D
.. I $TR($G(GMRCOM(GMRCOM1))," ","")'="" S GMRCERR=0 Q
I +$G(GMRCA),GMRCA=10 D
.S GMRCSF=$G(GMRCSF,"")
.S GMRCSTS=2
.S DR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
.S GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(+GMRCO)_$S(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
.I $P($G(^GMR(123,+GMRCO,0)),U,14),$P($G(^GMR(123,+GMRCO,0)),U,14)'=DUZ S GMRCADUZ($P($G(^(0)),U,14))=""
.Q
I $G(GMRCALF)=1 D
.N I
.F I=1:1 S X=$P(GMRCATO,";",I) Q:X="" S GMRCADUZ(X)=""
.Q
I $L(GMRCA),GMRCA=4 S DR=DR_$S($L(DR):";",1:"")_"9////^S X=GMRCA;15////^S X=GMRCSF" D
.S GMRCORTX=$S(GMRCSF="Y":"Sig Findings ",GMRCSF="N":"No Sig Findings ",1:"Unknown Sig Findings ")_"for consult "_$$ORTX^GMRCAU(GMRCO)
.I $P($G(^GMR(123,+GMRCO,0)),U,14),$P($G(^GMR(123,+GMRCO,0)),U,14)'=DUZ S GMRCADUZ($P($G(^(0)),U,14))=""
.S GMRCUPD=$$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
.I +GMRCUPD<2 S GMRCTM=1
.I +GMRCUPD>1,+$P($G(^GMR(123,+GMRCO,0)),U,14)=DUZ S GMRCTM=1
.Q
I $L(DR) S DIE="^GMR(123,",DA=GMRCO D ^DIE K DIE,DR
I '$O(GMRCOM(0)) D AUDIT^GMRCP
I $D(GMRCOM),$O(GMRCOM(0)) D
.N DA
.S DA=$$SETDA()
.D SETCOM(.GMRCOM,GMRCDUZ)
.Q
L -^GMR(123,GMRCO)
;
D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,$S(GMRCA=20:63,1:23),.GMRCADUZ,GMRCTM)
;
I $S(GMRCA=10:1,(GMRCA=4&($P(^GMR(123,GMRCO,0),U,12)=2)):1,1:0) D
. D EN^GMRCHL7($P(^GMR(123,GMRCO,0),"^",2),GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,GMRCAD)
K DIE,DR,DA,GMRCDT,GMRCNOW,GMRCAD,GMRCORNP,GMRCDUZ,GMRCRSLT,GMRCSTS,GMRCADUZ,GMRCORTX,GMRCDFN
Q GMRCERR_"^"_GMRCERMS
;
SCH(GMRCO,GMRCORNP,GMRCAD,GMRCADUZ,GMRCMT) ;schedule a consult API
; Input variables:
;GMRCO - The internal file number of the consult from File 123
;GMRCORNP - Name of the person who actually 'Received' the consult
;GMRCAD - Actual date time that consult was received into the service.
;GMRCADUZ - array of alert recipients as chosen by user (by reference)
; ARRAY(DUZ)=""
;GMRCMT - array of comments if entered (by reference)
; ARRAY(1)="FIRST LINE OF COMMENT"
; ARRAY(2)="SECOND LINE OF COMMENT"
;
;Output:
;GMRCERR - Error Condition Code: 0 = NO error, 1=error
;GMRCERMS - Error message or null
; returned as GMRCERR^GMRCERMS
;
N DFN,GMRCSTS,GMRCNOW,GMRCERR,GMRCERMS
S GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
S:$G(GMRCAD)="" GMRCAD=GMRCNOW
S:'$G(GMRCDUZ) GMRCDUZ=DUZ
S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" D Q GMRCERR_"^"_GMRCERMS
. S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found."
. D EXIT^GMRCGUIA
S GMRCSTS=8,GMRCA=8
D STATUS^GMRCP I $D(GMRCQUT) D EXIT^GMRCGUIA Q GMRCERR_"^"_GMRCERMS
I '$O(GMRCMT(0)) D AUDIT^GMRCP
I $O(GMRCMT(0)) D
. S DA=$$SETDA
. D SETCOM(.GMRCMT,GMRCDUZ)
D EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"","","",GMRCAD)
D ;send alerts
. N GMRCUPD,GMRCTM,TXT
. S TXT="Scheduled Consult: "_$$ORTX^GMRCAU(GMRCO)
. S GMRCTM=0
. I $P(^GMR(123,+GMRCO,0),U,14),$P(^GMR(123,+GMRCO,0),U,14)'=DUZ S GMRCADUZ($P(^(0),U,14))=""
. S GMRCUPD=$$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
. I +GMRCUPD<2 S GMRCTM=1
. I +GMRCUPD>1,+$P($G(^GMR(123,+GMRCO,0)),U,14)=DUZ S GMRCTM=1
. D MSG^GMRCP(DFN,TXT,GMRCO,63,.GMRCADUZ,GMRCTM)
D EXIT^GMRCGUIA
Q GMRCERR_"^"_GMRCERMS
DOCLIST(GMRCAR,GMRCDA,GMRCMED) ;return list of linked results
; Input:
; GMRCAR - array to return list, passed by reference
; GMRCDA - ien from file 123
; GMRCMED- 1 = include med results; 0 = only TIU docs
;
; Output:
; GMRCAR - array in format
; GMRCAR(0)=zero node of record
; GMRCAR(50,1)="ien;global ref," e.g. 5;TIU(8925, or 3;MCAR(691,
; GMRCAR(50,2)="ien;global ref,"
;
I '$D(^GMR(123,GMRCDA,0)) Q
S GMRCAR(0)=^GMR(123,GMRCDA,0),$P(GMRCAR(0),U,20)=""
N RES,CNT S RES="",CNT=1
F S RES=$O(^GMR(123,GMRCDA,50,"B",RES)) Q:RES="" D
. I '$G(GMRCMED) Q:RES'["TIU(8925"
. S GMRCAR(50,CNT)=RES
. I RES["MCAR" D
.. N ARR,STR
.. D MEDLKUP^MCARUTL3(.ARR,+$P(RES,"MCAR(",2),+RES)
.. I '+ARR K GMRCAR(50,CNT) Q
.. S STR=$P(ARR,U,9)_U_$P(ARR,U,6)_$S($P(ARR,U,10):"^^^^^^^^1",1:"")
.. S GMRCAR(50,CNT)=GMRCAR(50,CNT)_U_STR
. S CNT=CNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCGUIB 9957 printed Sep 23, 2025@19:21:40 Page 2
GMRCGUIB ;SLC/DCM,JFR,MA/AFS,PB - GUI actions for consults ; Jan 17, 2024@13:17
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,18,20,17,22,29,30,35,45,53,55,64,46,75,86,90,91,99,168,196**;DEC 27, 1997;Build 3
+2 ;
+3 ; Reference to MEDLKUP^MCARUTL3 in ICR #3280
+4 ; Reference to POST^HMPEVNT in ICR #6755
+5 ;
+6 ; Deprecated HCP interface via GMRC*3.0*196
+7 ;
SETDA() ;set DA of where audit actions are to be filed
+1 if '$DATA(^GMR(123,+GMRCO,40,0))
SET ^GMR(123,GMRCO,40,0)="^123.02DA^^"
+2 SET DA=$SELECT($PIECE(^GMR(123,+GMRCO,40,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
+3 SET $PIECE(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
+4 QUIT DA
REASON(GMRCFN,GMRCRQ,GMRCDT) ;Load the reason for the request into ^GMR(123,GMRCO,20
+1 ;GMRCFN=File 123 IFN; GMRCRQ=Array containing Reason For Request
+2 ;GMRCDT=Date time of entry
+3 SET ^GMR(123,GMRCFN,20,0)="^^^"_GMRCDT_"^"
+4 SET L=0
SET LN=1
FOR
SET L=$ORDER(GMRCRQ(L))
if L=""
QUIT
SET GMRCRQ(L)=$$CHKTXT^GMRCHL7U(GMRCRQ(L))
SET ^GMR(123,GMRCFN,20,LN,0)=GMRCRQ(L)
SET LN=LN+1
+5 SET LN=LN-1
SET $PIECE(^GMR(123,GMRCFN,20,0),"^",3)=LN
+6 KILL LN,L
+7 QUIT
SETCOM(COMMENT,WHO) ;Set comment array into tracking actions
+1 NEW GMRCNOW,DR,DIE,L
+2 SET L=0
FOR
SET L=$ORDER(COMMENT(L))
if L=""
QUIT
SET COMMENT(L)=$$CHKTXT^GMRCHL7U(COMMENT(L))
+3 SET GMRCNOW=$$NOW^XLFDT
+4 IF $PIECE($GET(^GMR(123,+GMRCO,0)),"^",11)=$GET(GMRCPA)
SET GMRCPA=""
+5 SET DIE="^GMR(123,GMRCO,40,"
SET DA(1)=GMRCO
SET DR=".01////^S X=GMRCNOW;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=$G(GMRCORNP);4////^S X=$S($G(WHO):WHO,1:DUZ);6////^S X=$G(GMRCFR);8////^S X=$G(GMRCFF);7////^S X=$G(GMRCPA)"
+6 DO ^DIE
+7 SET ^GMR(123,GMRCO,40,DA,1,0)="^^^^"_GMRCAD_"^"
+8 SET (GMRCND,GMRCND1)=0
FOR
SET GMRCND1=$ORDER(COMMENT(GMRCND1))
if GMRCND1=""
QUIT
SET GMRCND=GMRCND+1
SET ^GMR(123,GMRCO,40,DA,1,GMRCND,0)=COMMENT(GMRCND)
+9 SET $PIECE(^GMR(123,GMRCO,40,DA,1,0),"^",3)=GMRCND
SET $PIECE(^(0),"^",4)=GMRCND
SET ^GMR(123,GMRCO,40,"B",GMRCNOW,DA)=""
+10 ;alb/sat 86 - update AG xref
if $DATA(^GMR(123,+GMRCO,0))
DO AG123S1^GMRCXR(+GMRCO)
+11 ;
+12 ; if an IFC, call event handler to generate a msg to remote site
+13 IF $DATA(^GMR(123,+GMRCO,12))
IF $DATA(^(40,DA))
DO TRIGR^GMRCIEVT(GMRCO,DA)
+14 ;
+15 KILL GMRCND,GMRCND1
+16 QUIT
CMT(GMRCO,GMRCOM,GMRCADUZ,GMRCWHN,GMRCWHO) ;add comment to consult
+1 ; GMRCO = IEN from file 123
+2 ; GMRCOM = array of comments in format GMRCOM(1)="xxxx", GMRCOM(2)="xxx"
+3 ; GMRCADUZ = array of alert recipients as GMRCADUZ(DUZ)="" (optional)
+4 ; GMRCWHO = IEN from file 200 who's responsible activity (optional)
+5 ; GMRCWHN = date time of activity in FM format
+6 ; GMRCFORC = copy of GMRCADUZ; these users will recieve alert 63 even if alert is turned OFF; optional argument to MSG^GMRCP
+7 ;
+8 NEW DA,GMRCA,GMRCAD,GMRCORTX,GMRCDFN,GMRCTM,GMRCRP,GMRCUPD,GMRCFORC
+9 MERGE GMRCFORC=GMRCADUZ
+10 ; get next activity tracking entry
SET DA=$$SETDA
+11 SET GMRCA=20
SET GMRCAD=GMRCWHN
if $GET(GMRCWHO)
SET GMRCORNP=GMRCWHO
+12 DO SETCOM(.GMRCOM,$GET(GMRCWHO))
+13 ;if a Non VA Care consult, notify HCP of the comment
+14 ;I $$FEE^GMRCHL7H($$GET1^DIQ(123,+GMRCO,1,"I")) D COMMENT^GMRCHL7H(+GMRCO) ;p196 Deprecated
+15 ;p196 Deprecated
IF $$FEE^GMRCHL7H($$GET1^DIQ(123,+GMRCO,1,"I"))
QUIT
+16 ;if a Non VA Care consult, notify CCRA of the comment
+17 ;patch 99 to send to CCRA
IF $$FEE^GMRCCCRA($$GET1^DIQ(123,+GMRCO,1,"I"))
DO COMMENT^GMRCCCRA(+GMRCO)
+18 ;update LAST ACTION field even though no status change
Begin DoDot:1
+19 NEW GMRCDR,GMRCSTS
+20 SET GMRCSTS=""
SET GMRCDR="9////20"
+21 DO STATUS^GMRCP
End DoDot:1
+22 SET GMRCDFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
+23 SET GMRCORTX="Comment Added to Consult "
+24 ; DE6745 PB - Added to make a call to HMP to sync the patient comments
DO POST^HMPEVNT(GMRCDFN,"consult",GMRCO,"")
+25 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
Begin DoDot:1
+26 SET GMRCORTX="Comment Added to remote consult "
End DoDot:1
+27 SET GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
+28 SET GMRCRP=+$PIECE(^GMR(123,GMRCO,0),U,14)
+29 SET GMRCUPD=$$VALID^GMRCAU($PIECE(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
+30 ;alert team if ord. prov. takes the action
IF GMRCRP=DUZ
Begin DoDot:1
+31 SET GMRCTM=1
End DoDot:1
+32 ; alert ord. prov if update users takes action
IF GMRCUPD>1
IF GMRCRP'=DUZ
Begin DoDot:1
+33 SET GMRCADUZ(GMRCRP)=""
End DoDot:1
+34 ;alert both if not ord. prov or update user
IF '$GET(GMRCTM)
IF GMRCUPD<2
Begin DoDot:1
+35 SET GMRCTM=1
SET GMRCADUZ(GMRCRP)=""
End DoDot:1
+36 DO MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,63,.GMRCADUZ,$GET(GMRCTM),.GMRCFORC)
+37 QUIT
SFILE(GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD) ;Process various file update functions from the GUI for a consult
+1 ; ADMIN COMPLETE or SIGNIFICANT FINDINGS
+2 ;Input variables:
+3 ;GMRCO=File 123 IEN of the consult record
+4 ;GMRCA=pointer to REQUEST ACTION TYPES (#123.1) 10=complete, 4=Sig find.
+5 ;GMRCSF=Significant Findings flag: 'Y'= significant finding
+6 ; : 'N'= no significant finding
+7 ; : 'U'=unknown significant finding
+8 ;GMRCORNP=Provider Responsible for action
+9 ;GMRCDUZ=Person actually doing the action
+10 ;GMRCOM=An array of comments by reference ARRAY(1)="xxx",ARRAY(2)="xxx"
+11 ;GMRCALF=Flag to signal that alerts are to be sent; 'N'=NO, 'Y'=YES
+12 ;GMRCATO=Who alerts are to be sent to; a comma delimited string of DUZ's
+13 ;GMRCAD =FM date/time of activity
+14 ;
+15 ;Output:
+16 ; GMRCERR=Error Flag: 0 if no error, 1 if error occurred
+17 ; GMRCERMS - Error message or null
+18 ; returned as GMRCERR^GMRCERMS
+19 ;
+20 NEW GMRCERR,GMRCERMS,GMRCTM
+21 LOCK +^GMR(123,GMRCO):5
IF '$TEST
SET GMRCERR=1
SET GMRCERMS="Record Locked. File Update Not Accomplished."
QUIT GMRCERR_"^"_GMRCERMS
+22 SET GMRCERR=0
SET GMRCTM=0
SET GMRCERMS=""
SET DR=""
SET GMRCORTX=""
+23 NEW GMRCADUZ
SET GMRCADUZ=""
+24 SET GMRCNOW=$$NOW^XLFDT
SET GMRCSTS=$PIECE(^GMR(123,+GMRCO,0),"^",12)
SET GMRCDFN=$PIECE(^(0),"^",2)
+25 IF '$GET(GMRCDUZ)
SET GMRCDUZ=DUZ
+26 IF '$GET(GMRCAD)
SET GMRCAD=GMRCNOW
+27 ;Insure comment array contains text for Complete action.
+28 IF GMRCA=10
Begin DoDot:1
+29 SET GMRCERR=1
+30 IF '$DATA(GMRCOM)
QUIT
+31 NEW GMRCOM1
SET GMRCOM1=""
+32 FOR
SET GMRCOM1=$ORDER(GMRCOM(GMRCOM1))
if (GMRCOM1=""!(GMRCERR=0))
QUIT
Begin DoDot:2
+33 IF $TRANSLATE($GET(GMRCOM(GMRCOM1))," ","")'=""
SET GMRCERR=0
QUIT
End DoDot:2
End DoDot:1
IF GMRCERR=1
SET GMRCERMS="Comment field must contain a text value!"
QUIT GMRCERR_"^"_GMRCERMS
+34 IF +$GET(GMRCA)
IF GMRCA=10
Begin DoDot:1
+35 SET GMRCSF=$GET(GMRCSF,"")
+36 SET GMRCSTS=2
+37 SET DR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
+38 SET GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(+GMRCO)_$SELECT(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
+39 IF $PIECE($GET(^GMR(123,+GMRCO,0)),U,14)
IF $PIECE($GET(^GMR(123,+GMRCO,0)),U,14)'=DUZ
SET GMRCADUZ($PIECE($GET(^(0)),U,14))=""
+40 QUIT
End DoDot:1
+41 IF $GET(GMRCALF)=1
Begin DoDot:1
+42 NEW I
+43 FOR I=1:1
SET X=$PIECE(GMRCATO,";",I)
if X=""
QUIT
SET GMRCADUZ(X)=""
+44 QUIT
End DoDot:1
+45 IF $LENGTH(GMRCA)
IF GMRCA=4
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_"9////^S X=GMRCA;15////^S X=GMRCSF"
Begin DoDot:1
+46 SET GMRCORTX=$SELECT(GMRCSF="Y":"Sig Findings ",GMRCSF="N":"No Sig Findings ",1:"Unknown Sig Findings ")_"for consult "_$$ORTX^GMRCAU(GMRCO)
+47 IF $PIECE($GET(^GMR(123,+GMRCO,0)),U,14)
IF $PIECE($GET(^GMR(123,+GMRCO,0)),U,14)'=DUZ
SET GMRCADUZ($PIECE($GET(^(0)),U,14))=""
+48 SET GMRCUPD=$$VALID^GMRCAU($PIECE(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
+49 IF +GMRCUPD<2
SET GMRCTM=1
+50 IF +GMRCUPD>1
IF +$PIECE($GET(^GMR(123,+GMRCO,0)),U,14)=DUZ
SET GMRCTM=1
+51 QUIT
End DoDot:1
+52 IF $LENGTH(DR)
SET DIE="^GMR(123,"
SET DA=GMRCO
DO ^DIE
KILL DIE,DR
+53 IF '$ORDER(GMRCOM(0))
DO AUDIT^GMRCP
+54 IF $DATA(GMRCOM)
IF $ORDER(GMRCOM(0))
Begin DoDot:1
+55 NEW DA
+56 SET DA=$$SETDA()
+57 DO SETCOM(.GMRCOM,GMRCDUZ)
+58 QUIT
End DoDot:1
+59 LOCK -^GMR(123,GMRCO)
+60 ;
+61 DO MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,$SELECT(GMRCA=20:63,1:23),.GMRCADUZ,GMRCTM)
+62 ;
+63 IF $SELECT(GMRCA=10:1,(GMRCA=4&($PIECE(^GMR(123,GMRCO,0),U,12)=2)):1,1:0)
Begin DoDot:1
+64 DO EN^GMRCHL7($PIECE(^GMR(123,GMRCO,0),"^",2),GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),.GMRCOM,,GMRCAD)
End DoDot:1
+65 KILL DIE,DR,DA,GMRCDT,GMRCNOW,GMRCAD,GMRCORNP,GMRCDUZ,GMRCRSLT,GMRCSTS,GMRCADUZ,GMRCORTX,GMRCDFN
+66 QUIT GMRCERR_"^"_GMRCERMS
+67 ;
SCH(GMRCO,GMRCORNP,GMRCAD,GMRCADUZ,GMRCMT) ;schedule a consult API
+1 ; Input variables:
+2 ;GMRCO - The internal file number of the consult from File 123
+3 ;GMRCORNP - Name of the person who actually 'Received' the consult
+4 ;GMRCAD - Actual date time that consult was received into the service.
+5 ;GMRCADUZ - array of alert recipients as chosen by user (by reference)
+6 ; ARRAY(DUZ)=""
+7 ;GMRCMT - array of comments if entered (by reference)
+8 ; ARRAY(1)="FIRST LINE OF COMMENT"
+9 ; ARRAY(2)="SECOND LINE OF COMMENT"
+10 ;
+11 ;Output:
+12 ;GMRCERR - Error Condition Code: 0 = NO error, 1=error
+13 ;GMRCERMS - Error message or null
+14 ; returned as GMRCERR^GMRCERMS
+15 ;
+16 NEW DFN,GMRCSTS,GMRCNOW,GMRCERR,GMRCERMS
+17 SET GMRCERR=0
SET GMRCERMS=""
SET GMRCNOW=$$NOW^XLFDT
+18 if $GET(GMRCAD)=""
SET GMRCAD=GMRCNOW
+19 if '$GET(GMRCDUZ)
SET GMRCDUZ=DUZ
+20 SET DFN=$PIECE($GET(^GMR(123,GMRCO,0)),"^",2)
IF DFN=""
Begin DoDot:1
+21 SET GMRCERR="1"
SET GMRCERMS="Not A Valid Consult - File Not Found."
+22 DO EXIT^GMRCGUIA
End DoDot:1
QUIT GMRCERR_"^"_GMRCERMS
+23 SET GMRCSTS=8
SET GMRCA=8
+24 DO STATUS^GMRCP
IF $DATA(GMRCQUT)
DO EXIT^GMRCGUIA
QUIT GMRCERR_"^"_GMRCERMS
+25 IF '$ORDER(GMRCMT(0))
DO AUDIT^GMRCP
+26 IF $ORDER(GMRCMT(0))
Begin DoDot:1
+27 SET DA=$$SETDA
+28 DO SETCOM(.GMRCMT,GMRCDUZ)
End DoDot:1
+29 DO EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"","","",GMRCAD)
+30 ;send alerts
Begin DoDot:1
+31 NEW GMRCUPD,GMRCTM,TXT
+32 SET TXT="Scheduled Consult: "_$$ORTX^GMRCAU(GMRCO)
+33 SET GMRCTM=0
+34 IF $PIECE(^GMR(123,+GMRCO,0),U,14)
IF $PIECE(^GMR(123,+GMRCO,0),U,14)'=DUZ
SET GMRCADUZ($PIECE(^(0),U,14))=""
+35 SET GMRCUPD=$$VALID^GMRCAU($PIECE(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
+36 IF +GMRCUPD<2
SET GMRCTM=1
+37 IF +GMRCUPD>1
IF +$PIECE($GET(^GMR(123,+GMRCO,0)),U,14)=DUZ
SET GMRCTM=1
+38 DO MSG^GMRCP(DFN,TXT,GMRCO,63,.GMRCADUZ,GMRCTM)
End DoDot:1
+39 DO EXIT^GMRCGUIA
+40 QUIT GMRCERR_"^"_GMRCERMS
DOCLIST(GMRCAR,GMRCDA,GMRCMED) ;return list of linked results
+1 ; Input:
+2 ; GMRCAR - array to return list, passed by reference
+3 ; GMRCDA - ien from file 123
+4 ; GMRCMED- 1 = include med results; 0 = only TIU docs
+5 ;
+6 ; Output:
+7 ; GMRCAR - array in format
+8 ; GMRCAR(0)=zero node of record
+9 ; GMRCAR(50,1)="ien;global ref," e.g. 5;TIU(8925, or 3;MCAR(691,
+10 ; GMRCAR(50,2)="ien;global ref,"
+11 ;
+12 IF '$DATA(^GMR(123,GMRCDA,0))
QUIT
+13 SET GMRCAR(0)=^GMR(123,GMRCDA,0)
SET $PIECE(GMRCAR(0),U,20)=""
+14 NEW RES,CNT
SET RES=""
SET CNT=1
+15 FOR
SET RES=$ORDER(^GMR(123,GMRCDA,50,"B",RES))
if RES=""
QUIT
Begin DoDot:1
+16 IF '$GET(GMRCMED)
if RES'["TIU(8925"
QUIT
+17 SET GMRCAR(50,CNT)=RES
+18 IF RES["MCAR"
Begin DoDot:2
+19 NEW ARR,STR
+20 DO MEDLKUP^MCARUTL3(.ARR,+$PIECE(RES,"MCAR(",2),+RES)
+21 IF '+ARR
KILL GMRCAR(50,CNT)
QUIT
+22 SET STR=$PIECE(ARR,U,9)_U_$PIECE(ARR,U,6)_$SELECT($PIECE(ARR,U,10):"^^^^^^^^1",1:"")
+23 SET GMRCAR(50,CNT)=GMRCAR(50,CNT)_U_STR
End DoDot:2
+24 SET CNT=CNT+1
End DoDot:1
+25 QUIT
