Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCCP

GMRCCP.m

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