DGROUT ;DJH/AMA - ROM UTILITIES ; 28 Apr 2004 12:24 PM
;;5.3;Registration;**533,572,857**;Aug 13, 1993;Build 8
;
Q ;no direct entry
;
MPIOK(DGDFN,DGICN,DGLST) ;return non-local LST and ICN
;This function retrieves an ICN given a pointer to the PATIENT (#2)
;file for a patient. When the ICN is not local and the local site
;is not the Last Site Treated (LST), the LST is retrieved as a
;pointer to the INSTITUTION (#4) file.
; Called from SNDQRY^DGROHLR
;
; Supported DBIA #2701: The supported DBIA is used to access MPI
; APIs to retrieve ICN, determine if ICN
; is local and if site is LST.
; Supported DBIA #2702: The supported DBIA is used to retrieve the
; MPI node from the PATIENT (#2) file.
;
; Input:
; DGDFN - IEN of patient in PATIENT (#2) file
; DGICN - passed by reference to contain national ICN
; DGLST - passed by reference to contain LST
;
; Output:
; Function Value - 1 on national ICN and non-local LST, 0 on failure
; DGICN - Patient's Integrated Control Number
; DGLST - Pointer to INSTITUTION (#4) file for LST if LST
; is not local, undefined otherwise.
;
N DGRSLT
S DGRSLT=0
I $G(DGDFN)>0,$D(^DPT(DGDFN,"MPI")) D
. S DGICN=$$GETICN^MPIF001(DGDFN)
. ;
. ;ICN must be valid
. I (DGICN'>0) D Q
. . S DGMSG(1)=" "
. . S DGMSG(2)="The query to the LST has been terminated because required"
. . S DGMSG(3)="information was not provided by the MPI."
. . D EN^DDIOL(.DGMSG) R A:5
. ;
. ;ICN must not be local
. I $$IFLOCAL^MPIF001(DGDFN) D Q
. . S DGMSG(1)=" "
. . S DGMSG(2)="The query to the LST has been terminated because required"
. . S DGMSG(3)="information was not provided by the MPI."
. . D EN^DDIOL(.DGMSG) R A:5
. ;
. ;Get LST from Treating Facility List
. S DGLST=$$TFL(DGDFN)
. ;
. ; - Adding delay for TFL to complete if MPI card scan/swipe
. I $G(DGNEW),DGLST'>0 D
. . N DGHANG
. . W !,"Attempting to connect to the Master Patient Index in Austin..."
. . W !,"Looking for other treating facilities may take some time,"
. . W !,"please be patient..."
. . F DGHANG=1:1:30 H 1 S DGLST=$$TFL(DGDFN) Q:DGLST>0
. ;
. I (DGLST'>0) D Q
. . S DGMSG(1)=" "
. . S DGMSG(2)="The query to the LST has been terminated because required"
. . S DGMSG(3)="information was not provided by the MPI."
. . D EN^DDIOL(.DGMSG) R A:5
. ;
. S DGRSLT=1
Q DGRSLT
;
TFL(DFN) ;
;Retrieve Last Site Treated from the Treating Facility List ^DGCN(391.91
;This function will retrieve the most recent treatment site
;from the Treating Facility List (TFL) received from the MPI
;
; Input:
; DFN - (required) IEN of patient in PATIENT (#2) File
;
; Output:
; Function value - Facility IEN on success, 0 on failure
;
N RSLT ;Result returned from call
N QFL ;Quit flag
N TFLDR ;Treating Facility List Record Number
N DATA ;Array of TFL data
N RDATA ;Array of Treating Facilities arranged by date and TFLDR
N DATE,TFL
;
S (RSLT,QFL)=0
;Check to see if there is a TFL for this patient.
;If not exit and return -1 to call.
I '$D(^DGCN(391.91,"B",DFN)) G EXITTFL
;
;Go through the "B" index of TFL file and retrieve
;record numbers for the patient DFN.
S TFLDR="" F S TFLDR=$O(^DGCN(391.91,"B",DFN,TFLDR)) Q:TFLDR="" D
. ;Retrieve data from record and store in DATA array by record number.
. S DATA(TFLDR)=$G(^DGCN(391.91,TFLDR,0))
. ;Extract DATE from 3rd piece of record
. S DATE=$P(DATA(TFLDR),"^",3)
. ;Quit if DATE is null
. Q:DATE=""
. ;Get Station Number using the facility pointer to the Institution (#4) file
. S FAC=$P(DATA(TFLDR),"^",2)
. S FAC=$$STA^XUAF4(FAC) Q:FAC=""
. ;Build RDATA array using the DATE and TFLDR
. S RDATA(DATE,TFLDR)=FAC
;Exit if the RDATA array does not exist.
G:'$D(RDATA) EXITTFL
;
;Reverse order through the RDATA array (start with the latest date).
;Extract the treating facility from the RDATA array.
;Check the facility against local facility number: if they are
;the same, then get the next facility. (Should never happen)
S DATE="" F S DATE=$O(RDATA(DATE),-1) Q:DATE="" D Q:QFL=1
. S TFL="" F S TFL=$O(RDATA(DATE,TFL)) Q:TFL="" D Q:QFL=1
. . S FAC=RDATA(DATE,TFL) I FAC=$G(DIV(0)) Q
. . ;If the facility is not the current facility, then set RSLT to the facility and quit
. . S RSLT=FAC,QFL=1 ;set QFL to 1 to stop going through the RDATA array
EXITTFL Q RSLT ;Return the LST to the calling routine
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROUT 4649 printed Sep 23, 2025@20:31:16 Page 2
DGROUT ;DJH/AMA - ROM UTILITIES ; 28 Apr 2004 12:24 PM
+1 ;;5.3;Registration;**533,572,857**;Aug 13, 1993;Build 8
+2 ;
+3 ;no direct entry
QUIT
+4 ;
MPIOK(DGDFN,DGICN,DGLST) ;return non-local LST and ICN
+1 ;This function retrieves an ICN given a pointer to the PATIENT (#2)
+2 ;file for a patient. When the ICN is not local and the local site
+3 ;is not the Last Site Treated (LST), the LST is retrieved as a
+4 ;pointer to the INSTITUTION (#4) file.
+5 ; Called from SNDQRY^DGROHLR
+6 ;
+7 ; Supported DBIA #2701: The supported DBIA is used to access MPI
+8 ; APIs to retrieve ICN, determine if ICN
+9 ; is local and if site is LST.
+10 ; Supported DBIA #2702: The supported DBIA is used to retrieve the
+11 ; MPI node from the PATIENT (#2) file.
+12 ;
+13 ; Input:
+14 ; DGDFN - IEN of patient in PATIENT (#2) file
+15 ; DGICN - passed by reference to contain national ICN
+16 ; DGLST - passed by reference to contain LST
+17 ;
+18 ; Output:
+19 ; Function Value - 1 on national ICN and non-local LST, 0 on failure
+20 ; DGICN - Patient's Integrated Control Number
+21 ; DGLST - Pointer to INSTITUTION (#4) file for LST if LST
+22 ; is not local, undefined otherwise.
+23 ;
+24 NEW DGRSLT
+25 SET DGRSLT=0
+26 IF $GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,"MPI"))
Begin DoDot:1
+27 SET DGICN=$$GETICN^MPIF001(DGDFN)
+28 ;
+29 ;ICN must be valid
+30 IF (DGICN'>0)
Begin DoDot:2
+31 SET DGMSG(1)=" "
+32 SET DGMSG(2)="The query to the LST has been terminated because required"
+33 SET DGMSG(3)="information was not provided by the MPI."
+34 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:2
QUIT
+35 ;
+36 ;ICN must not be local
+37 IF $$IFLOCAL^MPIF001(DGDFN)
Begin DoDot:2
+38 SET DGMSG(1)=" "
+39 SET DGMSG(2)="The query to the LST has been terminated because required"
+40 SET DGMSG(3)="information was not provided by the MPI."
+41 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:2
QUIT
+42 ;
+43 ;Get LST from Treating Facility List
+44 SET DGLST=$$TFL(DGDFN)
+45 ;
+46 ; - Adding delay for TFL to complete if MPI card scan/swipe
+47 IF $GET(DGNEW)
IF DGLST'>0
Begin DoDot:2
+48 NEW DGHANG
+49 WRITE !,"Attempting to connect to the Master Patient Index in Austin..."
+50 WRITE !,"Looking for other treating facilities may take some time,"
+51 WRITE !,"please be patient..."
+52 FOR DGHANG=1:1:30
HANG 1
SET DGLST=$$TFL(DGDFN)
if DGLST>0
QUIT
End DoDot:2
+53 ;
+54 IF (DGLST'>0)
Begin DoDot:2
+55 SET DGMSG(1)=" "
+56 SET DGMSG(2)="The query to the LST has been terminated because required"
+57 SET DGMSG(3)="information was not provided by the MPI."
+58 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:2
QUIT
+59 ;
+60 SET DGRSLT=1
End DoDot:1
+61 QUIT DGRSLT
+62 ;
TFL(DFN) ;
+1 ;Retrieve Last Site Treated from the Treating Facility List ^DGCN(391.91
+2 ;This function will retrieve the most recent treatment site
+3 ;from the Treating Facility List (TFL) received from the MPI
+4 ;
+5 ; Input:
+6 ; DFN - (required) IEN of patient in PATIENT (#2) File
+7 ;
+8 ; Output:
+9 ; Function value - Facility IEN on success, 0 on failure
+10 ;
+11 ;Result returned from call
NEW RSLT
+12 ;Quit flag
NEW QFL
+13 ;Treating Facility List Record Number
NEW TFLDR
+14 ;Array of TFL data
NEW DATA
+15 ;Array of Treating Facilities arranged by date and TFLDR
NEW RDATA
+16 NEW DATE,TFL
+17 ;
+18 SET (RSLT,QFL)=0
+19 ;Check to see if there is a TFL for this patient.
+20 ;If not exit and return -1 to call.
+21 IF '$DATA(^DGCN(391.91,"B",DFN))
GOTO EXITTFL
+22 ;
+23 ;Go through the "B" index of TFL file and retrieve
+24 ;record numbers for the patient DFN.
+25 SET TFLDR=""
FOR
SET TFLDR=$ORDER(^DGCN(391.91,"B",DFN,TFLDR))
if TFLDR=""
QUIT
Begin DoDot:1
+26 ;Retrieve data from record and store in DATA array by record number.
+27 SET DATA(TFLDR)=$GET(^DGCN(391.91,TFLDR,0))
+28 ;Extract DATE from 3rd piece of record
+29 SET DATE=$PIECE(DATA(TFLDR),"^",3)
+30 ;Quit if DATE is null
+31 if DATE=""
QUIT
+32 ;Get Station Number using the facility pointer to the Institution (#4) file
+33 SET FAC=$PIECE(DATA(TFLDR),"^",2)
+34 SET FAC=$$STA^XUAF4(FAC)
if FAC=""
QUIT
+35 ;Build RDATA array using the DATE and TFLDR
+36 SET RDATA(DATE,TFLDR)=FAC
End DoDot:1
+37 ;Exit if the RDATA array does not exist.
+38 if '$DATA(RDATA)
GOTO EXITTFL
+39 ;
+40 ;Reverse order through the RDATA array (start with the latest date).
+41 ;Extract the treating facility from the RDATA array.
+42 ;Check the facility against local facility number: if they are
+43 ;the same, then get the next facility. (Should never happen)
+44 SET DATE=""
FOR
SET DATE=$ORDER(RDATA(DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+45 SET TFL=""
FOR
SET TFL=$ORDER(RDATA(DATE,TFL))
if TFL=""
QUIT
Begin DoDot:2
+46 SET FAC=RDATA(DATE,TFL)
IF FAC=$GET(DIV(0))
QUIT
+47 ;If the facility is not the current facility, then set RSLT to the facility and quit
+48 ;set QFL to 1 to stop going through the RDATA array
SET RSLT=FAC
SET QFL=1
End DoDot:2
if QFL=1
QUIT
End DoDot:1
if QFL=1
QUIT
EXITTFL ;Return the LST to the calling routine
QUIT RSLT
