GMRCTIU ;SLC/DCM - Consults - TIU utilities ;2/26/02 11:46
;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,18,15,17,22,27**;DEC 27, 1997
;
; This routine invokes IA #2427,#2638,#2832,#3161
;
GET(GMRCO,GMRCTUFN,GMRCTUST,GMRCAUTH) ;update Consult from TIU
;GMRCO=IFN from file 123
;GMRCTUFN=TIU IFN
;GMRCTUST=TIU status of report
;GMRCAUTH=Author of Document
N GMRCA,GMRCSTS,GMRCDFN,GMRCAD
S GMRCA=$S($G(GMRCTUST)["INCOMPLETE":9,1:10),GMRCSTS=$S(GMRCA=10:2,1:9)
I '+$G(GMRCA) S GMRCA=99,GMRCSTS=99
D:+$G(GMRCA) STATUS^GMRCTIU1
K GMRCOM,GMRCND,GMRCORNP,GMRCORTX,GMRCSA,GMRCSTS
Q
;
DSPLAY(GMRCTUFN,LINECT) ;Get TIU results narrative and get it ready for display
;GMRCTUFN=TIU IEN of results record
;LINECT=line count for list manager
N ND,GMRCARR
D RPC^TIUSRV(.GMRCARR,GMRCTUFN)
S ND=0
F S ND=$O(@GMRCARR@(ND)) Q:ND="" S ^TMP("GMRCR",$J,"DT",LINECT,0)=@GMRCARR@(ND,0),LINECT=LINECT+1
;D CLEAN^VALM10
K @GMRCARR,RESFL,GMRCTIUY
S:LINECT>1 LINECT=LINECT-1
Q
ENTER(GMRCO) ; Complete a consult with TIU note
N XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
D ENTER^GMRCTIUE(GMRCO)
Q
;
ADDEND(GMRCO) ; Make an addendum to a consult result
N XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
D ADDEND^GMRCTIUE(GMRCO)
Q
;
SEND(DFN,OVRRIDE,CP) ;Get consult list and return in ^TMP for TIU
;DFN=Patient's Internal file number from file 2
;OVRRIDE=BOOLEAN flag to override user validation
;CP=2 if only return entries that may have CP docs attached
;
N GMRCI,TAB
Q:DFN=""!(DFN<1)
S TAB="",$P(TAB," ",30)=""
K ^TMP("GMRCR",$J,"TIU")
D GETCONSL(DFN,2,$G(OVRRIDE),$G(CP)) ;2=returns TIU format in ^TMP
Q
;
RPCLIST(GMRCY,DFN) ;Get consult list and return in GMRCY for GUI
N GMRCI
I '+$G(DFN) S GMRCY(0)=0
D GETCONSL(DFN,1) ;1=returns GUI format in GMRCY array
; The consults will be returned from GETCONSL in the GMRCY array.
S GMRCY(0)=+$G(GMRCI)
Q
GETCONSL(DFN,ORIGIN,OVRRIDE,GMRCCP) ;Get the patients consults
;ORIGIN is whether the request is for GUI=1 or LM=2.
;The logic loops through the "AD" cross-reference to find consults
;The output will be formatted in GMRCY for the GUI if ORIGIN is 1.
;The output will be formatted in ^TMP("GMRCR",$J,"TIU" if ORIGIN is 2.
;GMRCCP = 1 = return only CP entries that can have CP doc attached
;
N GMRCQIT,GMRC,GMRCDA,GMRCDT,GMRCEDT,GMRCYR,GMRCSP,GMRCST,GMRCSTS
N GMRCTIU,GMRCTIUC,GMRCSS,GMRCSVC,GMRCPROC,GMRCNOTE,Y,GMRCDAT,GMRCAU
;
; Aug 2000 - MA changed routine to use Parameter global to set the
; number of days to look backward when getting a list of consults.
S GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
S GMRCYR=9999999-GMRCYR,GMRCDAT=0
F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:'GMRCDAT!(GMRCDAT>GMRCYR) D
. S GMRCDA=0
. F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA)) Q:'GMRCDA D
.. S GMRC(0)=$G(^GMR(123,GMRCDA,0))
.. S GMRCST=$P(GMRC(0),U,12)
.. I $P($G(^GMR(123,GMRCDA,12)),U,5)="P" Q ;can't attach to IFC placer
.. I "25689"'[GMRCST Q ;only return statuses c,p,a,s,pr
.. S GMRCDT=+GMRC(0)
.. S GMRCSS=$P(GMRC(0),U,5)
.. I '+$G(OVRRIDE) D Q:'GMRCAU
... S GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
... I GMRCAU=3 S GMRCAU=0 ;exclude admin users
.. I '$G(GMRCCP),+$G(^GMR(123,GMRCDA,1)) Q ;no CP requests for CPRS
.. I $G(GMRCCP),'+$G(^GMR(123,GMRCDA,1)) Q ;only return CP requests
.. S GMRCTIUC=0
.. D GETLIST^GMRCTIUL(GMRCDA,0,1,.GMRCTIUC)
.. I ORIGIN=1 D BLDGMRCY Q
.. I ORIGIN=2 D BLDTMP Q
.. Q
. Q
Q
;
BLDGMRCY ;Build the GMRCY array of existing consults
S GMRCSTS=$P($G(^ORD(100.01,+GMRCST,0)),"^",1)
S GMRCSS=$P(GMRC(0),U,5),GMRCSVC=$P($G(^GMR(123.5,GMRCSS,0)),U)
S GMRCPROC=$P($G(^GMR(123.3,+$P(GMRC(0),U,8),0)),U)
S GMRCI=+$G(GMRCI)+1
S GMRCY(GMRCI)=GMRCDA_U_GMRCDT_U_GMRCSVC_U_GMRCPROC_U_GMRCSTS_U_+GMRCTIUC(0)
Q
BLDTMP ;Build TMP global for TIU
S GMRCSTS=$G(^ORD(100.01,+GMRCST,.1))
S GMRCSP=$$ORTX^GMRCAU(GMRCDA)
S GMRCNOTE=$S(GMRCTIUC(0)=1:" note",1:" notes")
S GMRCEDT=$$FMTE^XLFDT(GMRCDT,"D")
S GMRCI=+$G(GMRCI)+1
S ^TMP("GMRCR",$J,"TIU",GMRCI,0)=$J(GMRCI,3)_"> "_$E(GMRCEDT_TAB,1,12)_" C#"_$E(GMRCDA_TAB,1,9)_$E(GMRCSP_TAB,1,21)_$E(GMRCSTS_TAB,1,4)_$E(+GMRCTIUC(0)_GMRCNOTE_TAB,1,10)
S ^TMP("GMRCR",$J,"TIU","B",GMRCI,GMRCDA)=""
Q
ANYPENDG(DFN,USER) ; Determine if user can update any unresolved CSLTs
; Input:
; DFN = patient being worked on or the one to check from file 2
; USER = the person to check on from file 200
;
; Output:
; 1 = yes there are unresolved consult that could be completed
; 0 = no unresolved consults that USER can update
;
N GMRCYR,GMRCDAT,GMRCDONE,GMRCDA,GMRCST,GMRC,GMRCSS,GMRCDT,GMRCAU
S GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
S GMRCYR=9999999-GMRCYR,GMRCDAT=0,GMRCDONE=0
F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:'GMRCDAT!(GMRCDAT>GMRCYR)!(GMRCDONE) D
. S GMRCDA=0
. F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA)) Q:'GMRCDA D
.. S GMRC(0)=$G(^GMR(123,GMRCDA,0))
.. S GMRCST=$P(GMRC(0),U,12)
.. I $P($G(^GMR(123,GMRCDA,12)),U,5)="P" Q ;can't attach to IFC placer
.. I +$G(^GMR(123,GMRCDA,1)) Q ;can't complete CP's from NOTES tab
.. I "568"'[GMRCST Q ;only return statuses p,a,s
.. S GMRCDT=+GMRC(0)
.. S GMRCSS=$P(GMRC(0),U,5)
.. D Q:'GMRCAU
... S GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
... I GMRCAU=3 S GMRCAU=0 ;exclude admin users
... I GMRCAU S GMRCDONE=1
Q GMRCDONE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCTIU 5479 printed Apr 09, 2024@20:51:44 Page 2
GMRCTIU ;SLC/DCM - Consults - TIU utilities ;2/26/02 11:46
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,18,15,17,22,27**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #2427,#2638,#2832,#3161
+4 ;
GET(GMRCO,GMRCTUFN,GMRCTUST,GMRCAUTH) ;update Consult from TIU
+1 ;GMRCO=IFN from file 123
+2 ;GMRCTUFN=TIU IFN
+3 ;GMRCTUST=TIU status of report
+4 ;GMRCAUTH=Author of Document
+5 NEW GMRCA,GMRCSTS,GMRCDFN,GMRCAD
+6 SET GMRCA=$SELECT($GET(GMRCTUST)["INCOMPLETE":9,1:10)
SET GMRCSTS=$SELECT(GMRCA=10:2,1:9)
+7 IF '+$GET(GMRCA)
SET GMRCA=99
SET GMRCSTS=99
+8 if +$GET(GMRCA)
DO STATUS^GMRCTIU1
+9 KILL GMRCOM,GMRCND,GMRCORNP,GMRCORTX,GMRCSA,GMRCSTS
+10 QUIT
+11 ;
DSPLAY(GMRCTUFN,LINECT) ;Get TIU results narrative and get it ready for display
+1 ;GMRCTUFN=TIU IEN of results record
+2 ;LINECT=line count for list manager
+3 NEW ND,GMRCARR
+4 DO RPC^TIUSRV(.GMRCARR,GMRCTUFN)
+5 SET ND=0
+6 FOR
SET ND=$ORDER(@GMRCARR@(ND))
if ND=""
QUIT
SET ^TMP("GMRCR",$JOB,"DT",LINECT,0)=@GMRCARR@(ND,0)
SET LINECT=LINECT+1
+7 ;D CLEAN^VALM10
+8 KILL @GMRCARR,RESFL,GMRCTIUY
+9 if LINECT>1
SET LINECT=LINECT-1
+10 QUIT
ENTER(GMRCO) ; Complete a consult with TIU note
+1 NEW XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
+2 DO ENTER^GMRCTIUE(GMRCO)
+3 QUIT
+4 ;
ADDEND(GMRCO) ; Make an addendum to a consult result
+1 NEW XQADATA,XQA,XQAID,XQAROU,XQFLG,XQAKILL
+2 DO ADDEND^GMRCTIUE(GMRCO)
+3 QUIT
+4 ;
SEND(DFN,OVRRIDE,CP) ;Get consult list and return in ^TMP for TIU
+1 ;DFN=Patient's Internal file number from file 2
+2 ;OVRRIDE=BOOLEAN flag to override user validation
+3 ;CP=2 if only return entries that may have CP docs attached
+4 ;
+5 NEW GMRCI,TAB
+6 if DFN=""!(DFN<1)
QUIT
+7 SET TAB=""
SET $PIECE(TAB," ",30)=""
+8 KILL ^TMP("GMRCR",$JOB,"TIU")
+9 ;2=returns TIU format in ^TMP
DO GETCONSL(DFN,2,$GET(OVRRIDE),$GET(CP))
+10 QUIT
+11 ;
RPCLIST(GMRCY,DFN) ;Get consult list and return in GMRCY for GUI
+1 NEW GMRCI
+2 IF '+$GET(DFN)
SET GMRCY(0)=0
+3 ;1=returns GUI format in GMRCY array
DO GETCONSL(DFN,1)
+4 ; The consults will be returned from GETCONSL in the GMRCY array.
+5 SET GMRCY(0)=+$GET(GMRCI)
+6 QUIT
GETCONSL(DFN,ORIGIN,OVRRIDE,GMRCCP) ;Get the patients consults
+1 ;ORIGIN is whether the request is for GUI=1 or LM=2.
+2 ;The logic loops through the "AD" cross-reference to find consults
+3 ;The output will be formatted in GMRCY for the GUI if ORIGIN is 1.
+4 ;The output will be formatted in ^TMP("GMRCR",$J,"TIU" if ORIGIN is 2.
+5 ;GMRCCP = 1 = return only CP entries that can have CP doc attached
+6 ;
+7 NEW GMRCQIT,GMRC,GMRCDA,GMRCDT,GMRCEDT,GMRCYR,GMRCSP,GMRCST,GMRCSTS
+8 NEW GMRCTIU,GMRCTIUC,GMRCSS,GMRCSVC,GMRCPROC,GMRCNOTE,Y,GMRCDAT,GMRCAU
+9 ;
+10 ; Aug 2000 - MA changed routine to use Parameter global to set the
+11 ; number of days to look backward when getting a list of consults.
+12 SET GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
+13 SET GMRCYR=9999999-GMRCYR
SET GMRCDAT=0
+14 FOR
SET GMRCDAT=$ORDER(^GMR(123,"AD",DFN,GMRCDAT))
if 'GMRCDAT!(GMRCDAT>GMRCYR)
QUIT
Begin DoDot:1
+15 SET GMRCDA=0
+16 FOR
SET GMRCDA=$ORDER(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA))
if 'GMRCDA
QUIT
Begin DoDot:2
+17 SET GMRC(0)=$GET(^GMR(123,GMRCDA,0))
+18 SET GMRCST=$PIECE(GMRC(0),U,12)
+19 ;can't attach to IFC placer
IF $PIECE($GET(^GMR(123,GMRCDA,12)),U,5)="P"
QUIT
+20 ;only return statuses c,p,a,s,pr
IF "25689"'[GMRCST
QUIT
+21 SET GMRCDT=+GMRC(0)
+22 SET GMRCSS=$PIECE(GMRC(0),U,5)
+23 IF '+$GET(OVRRIDE)
Begin DoDot:3
+24 SET GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
+25 ;exclude admin users
IF GMRCAU=3
SET GMRCAU=0
End DoDot:3
if 'GMRCAU
QUIT
+26 ;no CP requests for CPRS
IF '$GET(GMRCCP)
IF +$GET(^GMR(123,GMRCDA,1))
QUIT
+27 ;only return CP requests
IF $GET(GMRCCP)
IF '+$GET(^GMR(123,GMRCDA,1))
QUIT
+28 SET GMRCTIUC=0
+29 DO GETLIST^GMRCTIUL(GMRCDA,0,1,.GMRCTIUC)
+30 IF ORIGIN=1
DO BLDGMRCY
QUIT
+31 IF ORIGIN=2
DO BLDTMP
QUIT
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
+35 ;
BLDGMRCY ;Build the GMRCY array of existing consults
+1 SET GMRCSTS=$PIECE($GET(^ORD(100.01,+GMRCST,0)),"^",1)
+2 SET GMRCSS=$PIECE(GMRC(0),U,5)
SET GMRCSVC=$PIECE($GET(^GMR(123.5,GMRCSS,0)),U)
+3 SET GMRCPROC=$PIECE($GET(^GMR(123.3,+$PIECE(GMRC(0),U,8),0)),U)
+4 SET GMRCI=+$GET(GMRCI)+1
+5 SET GMRCY(GMRCI)=GMRCDA_U_GMRCDT_U_GMRCSVC_U_GMRCPROC_U_GMRCSTS_U_+GMRCTIUC(0)
+6 QUIT
BLDTMP ;Build TMP global for TIU
+1 SET GMRCSTS=$GET(^ORD(100.01,+GMRCST,.1))
+2 SET GMRCSP=$$ORTX^GMRCAU(GMRCDA)
+3 SET GMRCNOTE=$SELECT(GMRCTIUC(0)=1:" note",1:" notes")
+4 SET GMRCEDT=$$FMTE^XLFDT(GMRCDT,"D")
+5 SET GMRCI=+$GET(GMRCI)+1
+6 SET ^TMP("GMRCR",$JOB,"TIU",GMRCI,0)=$JUSTIFY(GMRCI,3)_"> "_$EXTRACT(GMRCEDT_TAB,1,12)_" C#"_$EXTRACT(GMRCDA_TAB,1,9)_$EXTRACT(GMRCSP_TAB,1,21)_$EXTRACT(GMRCSTS_TAB,1,4)_$EXTRACT(+GMRCTIUC(0)_GMRCNOTE_TAB,1,10)
+7 SET ^TMP("GMRCR",$JOB,"TIU","B",GMRCI,GMRCDA)=""
+8 QUIT
ANYPENDG(DFN,USER) ; Determine if user can update any unresolved CSLTs
+1 ; Input:
+2 ; DFN = patient being worked on or the one to check from file 2
+3 ; USER = the person to check on from file 200
+4 ;
+5 ; Output:
+6 ; 1 = yes there are unresolved consult that could be completed
+7 ; 0 = no unresolved consults that USER can update
+8 ;
+9 NEW GMRCYR,GMRCDAT,GMRCDONE,GMRCDA,GMRCST,GMRC,GMRCSS,GMRCDT,GMRCAU
+10 SET GMRCYR=$$FMADD^XLFDT(DT,-$$GET^XPAR("ALL","GMRC CONSULT LIST DAYS"))
+11 SET GMRCYR=9999999-GMRCYR
SET GMRCDAT=0
SET GMRCDONE=0
+12 FOR
SET GMRCDAT=$ORDER(^GMR(123,"AD",DFN,GMRCDAT))
if 'GMRCDAT!(GMRCDAT>GMRCYR)!(GMRCDONE)
QUIT
Begin DoDot:1
+13 SET GMRCDA=0
+14 FOR
SET GMRCDA=$ORDER(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA))
if 'GMRCDA
QUIT
Begin DoDot:2
+15 SET GMRC(0)=$GET(^GMR(123,GMRCDA,0))
+16 SET GMRCST=$PIECE(GMRC(0),U,12)
+17 ;can't attach to IFC placer
IF $PIECE($GET(^GMR(123,GMRCDA,12)),U,5)="P"
QUIT
+18 ;can't complete CP's from NOTES tab
IF +$GET(^GMR(123,GMRCDA,1))
QUIT
+19 ;only return statuses p,a,s
IF "568"'[GMRCST
QUIT
+20 SET GMRCDT=+GMRC(0)
+21 SET GMRCSS=$PIECE(GMRC(0),U,5)
+22 Begin DoDot:3
+23 SET GMRCAU=$$VALID^GMRCAU(GMRCSS,GMRCDA)
+24 ;exclude admin users
IF GMRCAU=3
SET GMRCAU=0
+25 IF GMRCAU
SET GMRCDONE=1
End DoDot:3
if 'GMRCAU
QUIT
End DoDot:2
End DoDot:1
+26 QUIT GMRCDONE
+27 ;
