- 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
- ;
- 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 ;
