GMRCCP ;SLC/JFR - utilities for clinical procedures; 10/07/04 15:24
;;3.0;CONSULT/REQUEST TRACKING;**17,25,37,55**;DEC 27, 1997;Build 4
;
; This routine invokes IAs #3378,#3468
;
Q
CPLIST(GMRCPT,GMRCPR,GMRCRET) ;return list of patient CP requests
; Input:
; GMRCPT = patient DFN (required)
; GMRCPR = ien from file 702.01 (optional)
; if just one procedure
; desired; defaults to all
; GMRCRET= global array in which to (required)
; return results
;
; Output:
; ^global(array)=
; date of request^CP DEF nam^urgency^status^cons #^CP DEF ien
;
N GMRCDA,COUNT
S COUNT=1
I '$G(GMRCPT)!('$D(GMRCRET)) Q
I $G(GMRCPR) D
. S GMRCDA=0
. F S GMRCDA=$O(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA)) Q:'GMRCDA D
.. I '$$EXTDATA^MDAPI(GMRCPR) Q ; if no ext. data, don't send
.. D LOADAR(GMRCDA,GMRCRET,COUNT) S COUNT=COUNT+1
. Q
I '$G(GMRCPR) S GMRCPR=0 D
. F S GMRCPR=$O(^GMR(123,"ACP",GMRCPR)) Q:'GMRCPR D
.. I '$$EXTDATA^MDAPI(GMRCPR) Q ;don't send if no ext. data
.. S GMRCDA=0
.. F S GMRCDA=$O(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA)) Q:'GMRCDA D
... D LOADAR(GMRCDA,GMRCRET,COUNT) S COUNT=COUNT+1
.. Q
. Q
Q
;
LOADAR(IEN,GMRCAR,CNT) ;set up array and return data for given file 123 ien
N GMRCDT,GMRCCP,GMRCUR,STS,GMRC,GMRCCPI
Q:'$D(^GMR(123,IEN,0))
Q:'+$G(^GMR(123,IEN,1))
S GMRC(0)=^GMR(123,IEN,0)
S GMRCDT=$P(GMRC(0),U,7)
S GMRCCPI=+^GMR(123,IEN,1)
S GMRCCP=$$GET1^DIQ(702.01,GMRCCPI,.01)
S GMRCUR=$$GET1^DIQ(101,+$P(GMRC(0),U,9),1)
S STS=$$GET1^DIQ(100.01,+$P(GMRC(0),U,12),.1)
S @(GMRCAR)@(CNT)=GMRCDT_U_GMRCCP_U_GMRCUR_U_STS_U_IEN_U_GMRCCPI
Q
;
CPROC(PROC) ;is orderable procedure mapped to Clinical Procedures
Q +$P($G(^GMR(123.3,PROC,0)),U,4)
CPLINK(PROC) ;check "AC" x-ref to see if PROC is linked to entry in 123.3
; PROC - ien from 702.01
Q $E($D(^GMR(123.3,"AC",+PROC)),1)
CPLINKS(NAMES,PROC) ;return list of procedure names linked to a CP
; Input
; PROC - ien from PROCEDURE DEFINITION (#702.01) - (required)
; Output:
; NAMES - passed by reference
; returned as array of GMRC PROCEDUREs linked to PROC
; in format;
; NAMES(x)=GMRC PROCEDURE name^GMRC PROCEDURE ien
; NAMES(1)="EKG^21"
; NAMES(2)="EKG PORTABLE^32"
; if not currently linked, returned as:
; NAMES(1)="-1^not currently linked"
N GMRCPR,I
S I=1,GMRCPR=0
F S GMRCPR=$O(^GMR(123.3,"AC",PROC,GMRCPR)) Q:'GMRCPR D
. S NAMES(I)=$P($G(^GMR(123.3,GMRCPR,0)),U)_U_GMRCPR
. S I=I+1
I '$D(NAMES(1)) S NAMES(1)="-1^not currently linked"
Q
CPDOC(GMRCDA,TIUDA,ACTION) ;update file 123 entry with CLIN PROC DOC
; Input:
; GMRCDA = ien from file 123
; TIUDA = ien from file 8925
; ACTION = 1 - associate stub record
; = 2 - partial results ready
; = 3 - retract record
;
; Output:
; 1 = successful
; 0^error = unsuccessful^problem
;
;
N QVAL,GMRCADUZ
I '$D(^GMR(123,+GMRCDA,0)) Q "0^Invalid procedure record"
I '$G(ACTION) Q "0^Invalid action code"
I '$G(TIUDA) Q "0^No document to associate"
S QVAL=""
I ACTION=1 D Q QVAL
. S QVAL="0^Not a current API implementation"
. Q
I ACTION=2 D Q QVAL
. N GMRCCPA
. I $D(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925")) Q
. S GMRCCPA=1 ; tell audit trail it's coming from CP ; slc/jfr 1/15/03
. D GET^GMRCTIU(+GMRCDA,TIUDA,"INCOMPLETE") ;update to pr
. D EN^GMRCT(+$P(^GMR(123,+GMRCDA,0),U,5)) ;get svc notif recips
. I $D(GMRCADUZ) D
.. N MSG,GMRCDFN,GMRCREF
.. S MSG="Procedure ready for interpretation"
.. S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
.. S GMRCREF=+GMRCDA_"|"_+TIUDA_";TIU(8925,"
.. D MSG^GMRCP(GMRCDFN,MSG,GMRCREF,66,.GMRCADUZ,0) ;send #66 alert
. S QVAL="1"
. Q
I ACTION=3 D Q QVAL
. I '$D(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925")) D Q
.. S QVAL="0^Not an associated document"
. D ROLLBACK^GMRCTIU1(+GMRCDA,+TIUDA)
. S QVAL=1
. Q
Q
CPACTM(GMRCDA) ;return actions available for a CP request
;Input:
; GMRCDA = file 123 ien
;Output:
; 0 = not a CP request or TIU*1*109 not present
; 1 = CP request but no instrument report expected
; 2 = CP and still waiting on instr. or images
; 3 = CP and incomplete CP doc attached
; 4 = CP and complete CP doc attached
;
N EXTDTA,CPDOC
I '$$PATCH^XPDUTL("TIU*1.0*109") Q 0
I '$G(^GMR(123,GMRCDA,1)) Q 0
S EXTDTA=$$EXTDATA^MDAPI(+^GMR(123,GMRCDA,1))
S CPDOC=$G(^GMR(123,GMRCDA,50,+$O(^GMR(123,GMRCDA,50,0)),0))
I 'EXTDTA,'+CPDOC Q 1 ;no ext & no stub
I EXTDTA,'+CPDOC Q 2 ;ext data & no data
I $$GET1^DIQ(8925,+CPDOC,.05)'="COMPLETED" Q 3 ;partial results
Q 4 ;CP is done, allow additional CP titles
;
CPINTERP(GMRCTIU,GMRCUSER) ;is user an interpreter for TIU doc GMRCTIU
;
; Input:
; GMRCTIU = ien from file 8925
; GMRCUSER = DUZ of person to evaluate
;
; Output:
; 1 = GMRCUSER is an interpreter
; 0 = GMRCUSER is NOT an interpreter
;
N GMRCSRV,GMRCDA,GMRCINT
S GMRCDA=$O(^GMR(123,"R",GMRCTIU_";TIU(8925,",0))
I 'GMRCDA Q 0 ;TIU doc not attached
S GMRCSRV=$P(^GMR(123,+GMRCDA,0),U,5)
I 'GMRCSRV Q 0 ;no service, can't tell if interpreter
S GMRCINT=+$$VALID^GMRCAU(GMRCSRV,,GMRCUSER) ;get upd authority
Q $S(GMRCINT=1:1,GMRCINT=2:1,GMRCINT=4:1,1:0) ;1=unrstrctd (upd) user, 2=upd user, 4=adm & upd user
;
CPPAT(GMRCDA,GMRCDFN) ;is patient object of given request?
; Input:
; GMRCDA = ien from file 123
; GMRCDFN = patient DFN
;
; Output:
; 1 = patient is object of request GMRCDA
; 0 = patient is NOT object of request in GMRCDA
I $P($G(^GMR(123,GMRCDA,0)),U,2)'=GMRCDFN Q 0
Q 1
;
MCCNVT(GMRCMOD,GMRCMC,GMRCTIU) ;convert MC pointer to TIU pointer in file 123
;Input:
; GMRCMOD = boolean 1 (convert if found) or 0 (test conversion)
; GMRCMC = var;ptr to a Medicine package result
; GMRCTIU = ptr to file 8925
;
;Output:
; -1^Description of error
; 0^No Action needed
; 1^Success message^Consult IEN
;
I '$D(GMRCMOD) Q "-1^Mode unknown"
I '$G(GMRCMC) Q "-1^No MC results sent"
N GMRCIEN,GMRCRIEN,GMRCACT,GMRCERR,FDA
S GMRCIEN=$O(^GMR(123,"R",GMRCMC,0))
I 'GMRCIEN Q "0^No action needed"
I GMRCMOD=0 Q "1^Not converted^"_GMRCIEN
I '$G(GMRCTIU) Q "-1^No TIU ref sent"
S GMRCRIEN=$O(^GMR(123,"R",GMRCMC,GMRCIEN,0))
S FDA(1,123.03,GMRCRIEN_","_GMRCIEN_",",.01)=GMRCTIU_";TIU(8925,"
D FILE^DIE("K","FDA(1)","GMRCERR")
I $D(GMRCERR) Q "-1^Unable to convert"
; rest of field conversions
I $P(^GMR(123,GMRCIEN,0),U,15)=GMRCMC D
. S FDA(1,123,GMRCIEN_",",11)="@"
. D FILE^DIE("K","FDA(1)","GMRCERR")
;
S GMRCACT=0
F S GMRCACT=$O(^GMR(123,GMRCIEN,40,GMRCACT)) Q:'GMRCACT D
. I $P(^GMR(123,GMRCIEN,40,GMRCACT,0),U,9)'=GMRCMC Q ;no need to chg
. K FDA,GMRCERR
. S FDA(1,123.02,GMRCACT_","_GMRCIEN_",",9)=GMRCTIU_";TIU(8925,"
. D FILE^DIE("K","FDA(1)","GMRCERR")
; NO IFC implications at this time
Q "1^Successfully converted^"_GMRCIEN
;
Q
GMRCCP ;SLC/JFR - utilities for clinical procedures; 10/07/04 15:24
+1 ;;3.0;CONSULT/REQUEST TRACKING;**17,25,37,55**;DEC 27, 1997;Build 4
+2 ;
+3 ; This routine invokes IAs #3378,#3468
+4 ;
+5 QUIT
CPLIST(GMRCPT,GMRCPR,GMRCRET) ;return list of patient CP requests
+1 ; Input:
+2 ; GMRCPT = patient DFN (required)
+3 ; GMRCPR = ien from file 702.01 (optional)
+4 ; if just one procedure
+5 ; desired; defaults to all
+6 ; GMRCRET= global array in which to (required)
+7 ; return results
+8 ;
+9 ; Output:
+10 ; ^global(array)=
+11 ; date of request^CP DEF nam^urgency^status^cons #^CP DEF ien
+12 ;
+13 NEW GMRCDA,COUNT
+14 SET COUNT=1
+15 IF '$GET(GMRCPT)!('$DATA(GMRCRET))
QUIT
+16 IF $GET(GMRCPR)
Begin DoDot:1
+17 SET GMRCDA=0
+18 FOR
SET GMRCDA=$ORDER(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA))
IF 'GMRCDA
QUIT
Begin DoDot:2
+19 ; if no ext. data, don't send
IF '$$EXTDATA^MDAPI(GMRCPR)
QUIT
+20 DO LOADAR(GMRCDA,GMRCRET,COUNT)
SET COUNT=COUNT+1
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF '$GET(GMRCPR)
SET GMRCPR=0
Begin DoDot:1
+23 FOR
SET GMRCPR=$ORDER(^GMR(123,"ACP",GMRCPR))
IF 'GMRCPR
QUIT
Begin DoDot:2
+24 ;don't send if no ext. data
IF '$$EXTDATA^MDAPI(GMRCPR)
QUIT
+25 SET GMRCDA=0
+26 FOR
SET GMRCDA=$ORDER(^GMR(123,"ACP",GMRCPR,GMRCPT,GMRCDA))
IF 'GMRCDA
QUIT
Begin DoDot:3
+27 DO LOADAR(GMRCDA,GMRCRET,COUNT)
SET COUNT=COUNT+1
End DoDot:3
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 QUIT
+31 ;
LOADAR(IEN,GMRCAR,CNT) ;set up array and return data for given file 123 ien
+1 NEW GMRCDT,GMRCCP,GMRCUR,STS,GMRC,GMRCCPI
+2 IF '$DATA(^GMR(123,IEN,0))
QUIT
+3 IF '+$GET(^GMR(123,IEN,1))
QUIT
+4 SET GMRC(0)=^GMR(123,IEN,0)
+5 SET GMRCDT=$PIECE(GMRC(0),U,7)
+6 SET GMRCCPI=+^GMR(123,IEN,1)
+7 SET GMRCCP=$$GET1^DIQ(702.01,GMRCCPI,.01)
+8 SET GMRCUR=$$GET1^DIQ(101,+$PIECE(GMRC(0),U,9),1)
+9 SET STS=$$GET1^DIQ(100.01,+$PIECE(GMRC(0),U,12),.1)
+10 SET @(GMRCAR)@(CNT)=GMRCDT_U_GMRCCP_U_GMRCUR_U_STS_U_IEN_U_GMRCCPI
+11 QUIT
+12 ;
CPROC(PROC) ;is orderable procedure mapped to Clinical Procedures
+1 QUIT +$PIECE($GET(^GMR(123.3,PROC,0)),U,4)
CPLINK(PROC) ;check "AC" x-ref to see if PROC is linked to entry in 123.3
+1 ; PROC - ien from 702.01
+2 QUIT $EXTRACT($DATA(^GMR(123.3,"AC",+PROC)),1)
CPLINKS(NAMES,PROC) ;return list of procedure names linked to a CP
+1 ; Input
+2 ; PROC - ien from PROCEDURE DEFINITION (#702.01) - (required)
+3 ; Output:
+4 ; NAMES - passed by reference
+5 ; returned as array of GMRC PROCEDUREs linked to PROC
+6 ; in format;
+7 ; NAMES(x)=GMRC PROCEDURE name^GMRC PROCEDURE ien
+8 ; NAMES(1)="EKG^21"
+9 ; NAMES(2)="EKG PORTABLE^32"
+10 ; if not currently linked, returned as:
+11 ; NAMES(1)="-1^not currently linked"
+12 NEW GMRCPR,I
+13 SET I=1
SET GMRCPR=0
+14 FOR
SET GMRCPR=$ORDER(^GMR(123.3,"AC",PROC,GMRCPR))
IF 'GMRCPR
QUIT
Begin DoDot:1
+15 SET NAMES(I)=$PIECE($GET(^GMR(123.3,GMRCPR,0)),U)_U_GMRCPR
+16 SET I=I+1
End DoDot:1
+17 IF '$DATA(NAMES(1))
SET NAMES(1)="-1^not currently linked"
+18 QUIT
CPDOC(GMRCDA,TIUDA,ACTION) ;update file 123 entry with CLIN PROC DOC
+1 ; Input:
+2 ; GMRCDA = ien from file 123
+3 ; TIUDA = ien from file 8925
+4 ; ACTION = 1 - associate stub record
+5 ; = 2 - partial results ready
+6 ; = 3 - retract record
+7 ;
+8 ; Output:
+9 ; 1 = successful
+10 ; 0^error = unsuccessful^problem
+11 ;
+12 ;
+13 NEW QVAL,GMRCADUZ
+14 IF '$DATA(^GMR(123,+GMRCDA,0))
QUIT "0^Invalid procedure record"
+15 IF '$GET(ACTION)
QUIT "0^Invalid action code"
+16 IF '$GET(TIUDA)
QUIT "0^No document to associate"
+17 SET QVAL=""
+18 IF ACTION=1
Begin DoDot:1
+19 SET QVAL="0^Not a current API implementation"
+20 QUIT
End DoDot:1
QUIT QVAL
+21 IF ACTION=2
Begin DoDot:1
+22 NEW GMRCCPA
+23 IF $DATA(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925"))
QUIT
+24 ; tell audit trail it's coming from CP ; slc/jfr 1/15/03
SET GMRCCPA=1
+25 ;update to pr
DO GET^GMRCTIU(+GMRCDA,TIUDA,"INCOMPLETE")
+26 ;get svc notif recips
DO EN^GMRCT(+$PIECE(^GMR(123,+GMRCDA,0),U,5))
+27 IF $DATA(GMRCADUZ)
Begin DoDot:2
+28 NEW MSG,GMRCDFN,GMRCREF
+29 SET MSG="Procedure ready for interpretation"
+30 SET GMRCDFN=$PIECE(^GMR(123,+GMRCDA,0),U,2)
+31 SET GMRCREF=+GMRCDA_"|"_+TIUDA_";TIU(8925,"
+32 ;send #66 alert
DO MSG^GMRCP(GMRCDFN,MSG,GMRCREF,66,.GMRCADUZ,0)
End DoDot:2
+33 SET QVAL="1"
+34 QUIT
End DoDot:1
QUIT QVAL
+35 IF ACTION=3
Begin DoDot:1
+36 IF '$DATA(^GMR(123,+GMRCDA,50,"B",TIUDA_";TIU(8925"))
Begin DoDot:2
+37 SET QVAL="0^Not an associated document"
End DoDot:2
QUIT
+38 DO ROLLBACK^GMRCTIU1(+GMRCDA,+TIUDA)
+39 SET QVAL=1
+40 QUIT
End DoDot:1
QUIT QVAL
+41 QUIT
CPACTM(GMRCDA) ;return actions available for a CP request
+1 ;Input:
+2 ; GMRCDA = file 123 ien
+3 ;Output:
+4 ; 0 = not a CP request or TIU*1*109 not present
+5 ; 1 = CP request but no instrument report expected
+6 ; 2 = CP and still waiting on instr. or images
+7 ; 3 = CP and incomplete CP doc attached
+8 ; 4 = CP and complete CP doc attached
+9 ;
+10 NEW EXTDTA,CPDOC
+11 IF '$$PATCH^XPDUTL("TIU*1.0*109")
QUIT 0
+12 IF '$GET(^GMR(123,GMRCDA,1))
QUIT 0
+13 SET EXTDTA=$$EXTDATA^MDAPI(+^GMR(123,GMRCDA,1))
+14 SET CPDOC=$GET(^GMR(123,GMRCDA,50,+$ORDER(^GMR(123,GMRCDA,50,0)),0))
+15 ;no ext & no stub
IF 'EXTDTA
IF '+CPDOC
QUIT 1
+16 ;ext data & no data
IF EXTDTA
IF '+CPDOC
QUIT 2
+17 ;partial results
IF $$GET1^DIQ(8925,+CPDOC,.05)'="COMPLETED"
QUIT 3
+18 ;CP is done, allow additional CP titles
QUIT 4
+19 ;
CPINTERP(GMRCTIU,GMRCUSER) ;is user an interpreter for TIU doc GMRCTIU
+1 ;
+2 ; Input:
+3 ; GMRCTIU = ien from file 8925
+4 ; GMRCUSER = DUZ of person to evaluate
+5 ;
+6 ; Output:
+7 ; 1 = GMRCUSER is an interpreter
+8 ; 0 = GMRCUSER is NOT an interpreter
+9 ;
+10 NEW GMRCSRV,GMRCDA,GMRCINT
+11 SET GMRCDA=$ORDER(^GMR(123,"R",GMRCTIU_";TIU(8925,",0))
+12 ;TIU doc not attached
IF 'GMRCDA
QUIT 0
+13 SET GMRCSRV=$PIECE(^GMR(123,+GMRCDA,0),U,5)
+14 ;no service, can't tell if interpreter
IF 'GMRCSRV
QUIT 0
+15 ;get upd authority
SET GMRCINT=+$$VALID^GMRCAU(GMRCSRV,,GMRCUSER)
+16 ;1=unrstrctd (upd) user, 2=upd user, 4=adm & upd user
QUIT $SELECT(GMRCINT=1:1,GMRCINT=2:1,GMRCINT=4:1,1:0)
+17 ;
CPPAT(GMRCDA,GMRCDFN) ;is patient object of given request?
+1 ; Input:
+2 ; GMRCDA = ien from file 123
+3 ; GMRCDFN = patient DFN
+4 ;
+5 ; Output:
+6 ; 1 = patient is object of request GMRCDA
+7 ; 0 = patient is NOT object of request in GMRCDA
+8 IF $PIECE($GET(^GMR(123,GMRCDA,0)),U,2)'=GMRCDFN
QUIT 0
+9 QUIT 1
+10 ;
MCCNVT(GMRCMOD,GMRCMC,GMRCTIU) ;convert MC pointer to TIU pointer in file 123
+1 ;Input:
+2 ; GMRCMOD = boolean 1 (convert if found) or 0 (test conversion)
+3 ; GMRCMC = var;ptr to a Medicine package result
+4 ; GMRCTIU = ptr to file 8925
+5 ;
+6 ;Output:
+7 ; -1^Description of error
+8 ; 0^No Action needed
+9 ; 1^Success message^Consult IEN
+10 ;
+11 IF '$DATA(GMRCMOD)
QUIT "-1^Mode unknown"
+12 IF '$GET(GMRCMC)
QUIT "-1^No MC results sent"
+13 NEW GMRCIEN,GMRCRIEN,GMRCACT,GMRCERR,FDA
+14 SET GMRCIEN=$ORDER(^GMR(123,"R",GMRCMC,0))
+15 IF 'GMRCIEN
QUIT "0^No action needed"
+16 IF GMRCMOD=0
QUIT "1^Not converted^"_GMRCIEN
+17 IF '$GET(GMRCTIU)
QUIT "-1^No TIU ref sent"
+18 SET GMRCRIEN=$ORDER(^GMR(123,"R",GMRCMC,GMRCIEN,0))
+19 SET FDA(1,123.03,GMRCRIEN_","_GMRCIEN_",",.01)=GMRCTIU_";TIU(8925,"
+20 DO FILE^DIE("K","FDA(1)","GMRCERR")
+21 IF $DATA(GMRCERR)
QUIT "-1^Unable to convert"
+22 ; rest of field conversions
+23 IF $PIECE(^GMR(123,GMRCIEN,0),U,15)=GMRCMC
Begin DoDot:1
+24 SET FDA(1,123,GMRCIEN_",",11)="@"
+25 DO FILE^DIE("K","FDA(1)","GMRCERR")
End DoDot:1
+26 ;
+27 SET GMRCACT=0
+28 FOR
SET GMRCACT=$ORDER(^GMR(123,GMRCIEN,40,GMRCACT))
IF 'GMRCACT
QUIT
Begin DoDot:1
+29 ;no need to chg
IF $PIECE(^GMR(123,GMRCIEN,40,GMRCACT,0),U,9)'=GMRCMC
QUIT
+30 KILL FDA,GMRCERR
+31 SET FDA(1,123.02,GMRCACT_","_GMRCIEN_",",9)=GMRCTIU_";TIU(8925,"
+32 DO FILE^DIE("K","FDA(1)","GMRCERR")
End DoDot:1
+33 ; NO IFC implications at this time
+34 QUIT "1^Successfully converted^"_GMRCIEN
+35 ;
+36 QUIT
