GMRCAPI ;SLC/MKB,ASMR/BL -- Consult APIs ;Jun 16, 2020@05:56:23
;;3.0;CONSULT/REQUEST TRACKING;**80,145**;DEC 27, 1997;Build 18
;Per VA directive #6402, this routine should not be modified.
;Use of this routine is controlled by IA #6082
;
GET(GMRCAR,GMRCDA,GMRCMED) ;return basic data & list of linked results
; Input:
; GMRCAR - array to return list, passed by reference
; GMRCDA - ien from file 123
; GMRCMED- 1 = include Medicine pkg results; 0 = only TIU docs
;
; Output:
; GMRCAR - array in format:
; GMRCAR(0) = zero node of record
; GMRCAR(1) = CP procedure name
; GMRCAR(20) = Reason for Request (wp)
; GMRCAR(30) = Prov Dx
; GMRCAR(30.1) = Prov Dx codes
; GMRCAR(50,n) = "ien;global ref," e.g. 5;TIU(8925, or 3;MCAR(691,
; GMRCAR(75) = decision support tool id
;
I '$D(^GMR(123,GMRCDA,0)) Q
N X,P,RES,CNT
S GMRCAR(0)=^GMR(123,GMRCDA,0)
S $P(GMRCAR(0),U,20)="" ;return TIU note in 50 list
; resolve GMRC file pointers to external format
S X=$P(GMRCAR(0),U,5) S:X $P(GMRCAR(0),U,5)=$P($G(^GMR(123.5,X,0)),U)
S X=$P(GMRCAR(0),U,8) I X D
. S:X["123.3" $P(GMRCAR(0),U,8)=$P($G(^GMR(123.3,+X,0)),U)
. S:X["101" $P(GMRCAR(0),U,8)=$P($G(^ORD(101,+X,0)),U)
F P=9,10 S X=$P(GMRCAR(0),U,P) I X S $P(GMRCAR(0),U,P)=$$GET1^DIQ(101,X_",",1)
S X=$P(GMRCAR(0),U,12) S:X $P(GMRCAR(0),U,12)=$P($G(^ORD(100.01,X,0)),U)
S X=$P(GMRCAR(0),U,13) S:X $P(GMRCAR(0),U,13)=$P($G(^GMR(123.1,X,0)),U)
;
S X=$G(^GMR(123,GMRCDA,1)) I X S GMRCAR(1)=$$EXTERNAL^DILFD(123,1.01,,X)
I $D(^GMR(123,GMRCDA,20)) M GMRCAR(20)=^(20)
F X=30,30.1 I $L($G(^GMR(123,GMRCDA,X))) S GMRCAR(X)=^(X) ;Prov Dx
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:"")
.. ; procedure name ^ date.time ^^^^^^^^ 1=has image(s)
.. S GMRCAR(50,CNT)=GMRCAR(50,CNT)_U_STR
. S CNT=CNT+1
S:$D(^GMR(123,GMRCDA,75)) GMRCAR(75)=$G(^GMR(123,GMRCDA,75))
Q
;
IFC(GMRCDA) ;return IFC information
; Input:
; GMRCDA - ien from file 123
;
; Output:
; IFC fields as a string with these pieces:
; 1 - IFC REMOTE SERVICE NAME (#.131)
; 2 - REMOTE REQUESTOR PHONE (#.132)
; 3 - REMOTE REQUESTOR DIG PAGER (#.133)
; 5 - IFC ROLE (#.125)
; 6 - REMOTE ORDERING PROVIDER (#.126)
; 7 - REMOTE CONSULT FILE ENTRY (#.06)
; 8 - ROUTING FACILITY (#.07)
;
I '$D(^GMR(123,GMRCDA,0)) Q ""
N X0,X12,Y
S X0=$G(^GMR(123,GMRCDA,0)),X12=$G(^(12)),Y=$G(^(13))
S $P(Y,U,5,6)=$P(X12,U,5,6)
S $P(Y,U,7,8)=$P(X0,U,22,23)
Q Y
;
ACT(GMRCAR,GMRCDA) ;return Activity data
; Input:
; GMRCAR - array to return list, passed by reference
; GMRCDA - ien from file 123
;
; Output:
; GMRCAR - array in format:
; GMRCAR(n,0) = zero node of record
; GMRCAR(n,1) = comment (wp)
; GMRCAR(n,2) = two node of record
; GMRCAR(n,3) = three node of record
;
I '$D(^GMR(123,GMRCDA,0)) Q
N I,X0,X
S I=0 F S I=$O(^GMR(123,GMRCDA,40,I)) Q:I<1 S X0=$G(^(I,0)) D
. ; resolve GMRC file pointers to external format
. S X=$P(X0,U,2) S:X $P(X0,U,2)=$P($G(^GMR(123.1,X,0)),U)
. S X=$P(X0,U,6) S:X $P(X0,U,6)=$P($G(^GMR(123.5,X,0)),U)
. S GMRCAR(I,0)=X0
. I $D(^GMR(123,GMRCDA,40,I,1)) M GMRCAR(I,1)=^(1)
. I $D(^GMR(123,GMRCDA,40,I,2)) S GMRCAR(I,2)=^(2)
. I $D(^GMR(123,GMRCDA,40,I,3)) S GMRCAR(I,3)=^(3)
Q
CONS4PT(GMRCAR,GMRCPT) ; return consults for patient
; Input:
; GMRCAR - array to return list, passed by reference
; GMRCPT - DFN of patient from file #2
;
; Output:
; GMRCAR - array in format:
; GMRCAR(n) = Consult IEN
; GMRCAR=0 if no patient, or no consults found for patient
I $G(GMRCPT)="" S GMRCAR=0 Q
I '$D(^GMR(123,"F",GMRCPT)) S GMRCAR=0 Q
N GMRCIEN,CNT S CNT=1,GMRCIEN=""
F S GMRCIEN=$O(^GMR(123,"F",GMRCPT,GMRCIEN)) Q:GMRCIEN="" D
. S GMRCAR(CNT)=GMRCIEN,CNT=CNT+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCAPI 4151 printed Sep 23, 2025@19:21:05 Page 2
GMRCAPI ;SLC/MKB,ASMR/BL -- Consult APIs ;Jun 16, 2020@05:56:23
+1 ;;3.0;CONSULT/REQUEST TRACKING;**80,145**;DEC 27, 1997;Build 18
+2 ;Per VA directive #6402, this routine should not be modified.
+3 ;Use of this routine is controlled by IA #6082
+4 ;
GET(GMRCAR,GMRCDA,GMRCMED) ;return basic data & 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 Medicine pkg results; 0 = only TIU docs
+5 ;
+6 ; Output:
+7 ; GMRCAR - array in format:
+8 ; GMRCAR(0) = zero node of record
+9 ; GMRCAR(1) = CP procedure name
+10 ; GMRCAR(20) = Reason for Request (wp)
+11 ; GMRCAR(30) = Prov Dx
+12 ; GMRCAR(30.1) = Prov Dx codes
+13 ; GMRCAR(50,n) = "ien;global ref," e.g. 5;TIU(8925, or 3;MCAR(691,
+14 ; GMRCAR(75) = decision support tool id
+15 ;
+16 IF '$DATA(^GMR(123,GMRCDA,0))
QUIT
+17 NEW X,P,RES,CNT
+18 SET GMRCAR(0)=^GMR(123,GMRCDA,0)
+19 ;return TIU note in 50 list
SET $PIECE(GMRCAR(0),U,20)=""
+20 ; resolve GMRC file pointers to external format
+21 SET X=$PIECE(GMRCAR(0),U,5)
if X
SET $PIECE(GMRCAR(0),U,5)=$PIECE($GET(^GMR(123.5,X,0)),U)
+22 SET X=$PIECE(GMRCAR(0),U,8)
IF X
Begin DoDot:1
+23 if X["123.3"
SET $PIECE(GMRCAR(0),U,8)=$PIECE($GET(^GMR(123.3,+X,0)),U)
+24 if X["101"
SET $PIECE(GMRCAR(0),U,8)=$PIECE($GET(^ORD(101,+X,0)),U)
End DoDot:1
+25 FOR P=9,10
SET X=$PIECE(GMRCAR(0),U,P)
IF X
SET $PIECE(GMRCAR(0),U,P)=$$GET1^DIQ(101,X_",",1)
+26 SET X=$PIECE(GMRCAR(0),U,12)
if X
SET $PIECE(GMRCAR(0),U,12)=$PIECE($GET(^ORD(100.01,X,0)),U)
+27 SET X=$PIECE(GMRCAR(0),U,13)
if X
SET $PIECE(GMRCAR(0),U,13)=$PIECE($GET(^GMR(123.1,X,0)),U)
+28 ;
+29 SET X=$GET(^GMR(123,GMRCDA,1))
IF X
SET GMRCAR(1)=$$EXTERNAL^DILFD(123,1.01,,X)
+30 IF $DATA(^GMR(123,GMRCDA,20))
MERGE GMRCAR(20)=^(20)
+31 ;Prov Dx
FOR X=30,30.1
IF $LENGTH($GET(^GMR(123,GMRCDA,X)))
SET GMRCAR(X)=^(X)
+32 SET RES=""
SET CNT=1
FOR
SET RES=$ORDER(^GMR(123,GMRCDA,50,"B",RES))
if RES=""
QUIT
Begin DoDot:1
+33 IF '$GET(GMRCMED)
if RES'["TIU(8925"
QUIT
+34 SET GMRCAR(50,CNT)=RES
+35 IF RES["MCAR"
Begin DoDot:2
+36 NEW ARR,STR
+37 DO MEDLKUP^MCARUTL3(.ARR,+$PIECE(RES,"MCAR(",2),+RES)
+38 IF '+ARR
KILL GMRCAR(50,CNT)
QUIT
+39 SET STR=$PIECE(ARR,U,9)_U_$PIECE(ARR,U,6)_$SELECT($PIECE(ARR,U,10):"^^^^^^^^1",1:"")
+40 ; procedure name ^ date.time ^^^^^^^^ 1=has image(s)
+41 SET GMRCAR(50,CNT)=GMRCAR(50,CNT)_U_STR
End DoDot:2
+42 SET CNT=CNT+1
End DoDot:1
+43 if $DATA(^GMR(123,GMRCDA,75))
SET GMRCAR(75)=$GET(^GMR(123,GMRCDA,75))
+44 QUIT
+45 ;
IFC(GMRCDA) ;return IFC information
+1 ; Input:
+2 ; GMRCDA - ien from file 123
+3 ;
+4 ; Output:
+5 ; IFC fields as a string with these pieces:
+6 ; 1 - IFC REMOTE SERVICE NAME (#.131)
+7 ; 2 - REMOTE REQUESTOR PHONE (#.132)
+8 ; 3 - REMOTE REQUESTOR DIG PAGER (#.133)
+9 ; 5 - IFC ROLE (#.125)
+10 ; 6 - REMOTE ORDERING PROVIDER (#.126)
+11 ; 7 - REMOTE CONSULT FILE ENTRY (#.06)
+12 ; 8 - ROUTING FACILITY (#.07)
+13 ;
+14 IF '$DATA(^GMR(123,GMRCDA,0))
QUIT ""
+15 NEW X0,X12,Y
+16 SET X0=$GET(^GMR(123,GMRCDA,0))
SET X12=$GET(^(12))
SET Y=$GET(^(13))
+17 SET $PIECE(Y,U,5,6)=$PIECE(X12,U,5,6)
+18 SET $PIECE(Y,U,7,8)=$PIECE(X0,U,22,23)
+19 QUIT Y
+20 ;
ACT(GMRCAR,GMRCDA) ;return Activity data
+1 ; Input:
+2 ; GMRCAR - array to return list, passed by reference
+3 ; GMRCDA - ien from file 123
+4 ;
+5 ; Output:
+6 ; GMRCAR - array in format:
+7 ; GMRCAR(n,0) = zero node of record
+8 ; GMRCAR(n,1) = comment (wp)
+9 ; GMRCAR(n,2) = two node of record
+10 ; GMRCAR(n,3) = three node of record
+11 ;
+12 IF '$DATA(^GMR(123,GMRCDA,0))
QUIT
+13 NEW I,X0,X
+14 SET I=0
FOR
SET I=$ORDER(^GMR(123,GMRCDA,40,I))
if I<1
QUIT
SET X0=$GET(^(I,0))
Begin DoDot:1
+15 ; resolve GMRC file pointers to external format
+16 SET X=$PIECE(X0,U,2)
if X
SET $PIECE(X0,U,2)=$PIECE($GET(^GMR(123.1,X,0)),U)
+17 SET X=$PIECE(X0,U,6)
if X
SET $PIECE(X0,U,6)=$PIECE($GET(^GMR(123.5,X,0)),U)
+18 SET GMRCAR(I,0)=X0
+19 IF $DATA(^GMR(123,GMRCDA,40,I,1))
MERGE GMRCAR(I,1)=^(1)
+20 IF $DATA(^GMR(123,GMRCDA,40,I,2))
SET GMRCAR(I,2)=^(2)
+21 IF $DATA(^GMR(123,GMRCDA,40,I,3))
SET GMRCAR(I,3)=^(3)
End DoDot:1
+22 QUIT
CONS4PT(GMRCAR,GMRCPT) ; return consults for patient
+1 ; Input:
+2 ; GMRCAR - array to return list, passed by reference
+3 ; GMRCPT - DFN of patient from file #2
+4 ;
+5 ; Output:
+6 ; GMRCAR - array in format:
+7 ; GMRCAR(n) = Consult IEN
+8 ; GMRCAR=0 if no patient, or no consults found for patient
+9 IF $GET(GMRCPT)=""
SET GMRCAR=0
QUIT
+10 IF '$DATA(^GMR(123,"F",GMRCPT))
SET GMRCAR=0
QUIT
+11 NEW GMRCIEN,CNT
SET CNT=1
SET GMRCIEN=""
+12 FOR
SET GMRCIEN=$ORDER(^GMR(123,"F",GMRCPT,GMRCIEN))
if GMRCIEN=""
QUIT
Begin DoDot:1
+13 SET GMRCAR(CNT)=GMRCIEN
SET CNT=CNT+1
End DoDot:1
+14 QUIT
+15 ;
