PSORMRX ;BIRM/JAM - REMOTE DATA INTEROPERABILITY UTILITY ; 10/29/08
;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
;;
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;References to ORRDI1 supported by DBIA 4659
;
EN(PSODFN) ;- ListManager entry point
;
S PSORFLG=1
D EN^VALM("PSO RDI VISITS")
D FULL^VALM1
G EXIT
;
HDR ; Patient Header for remote site
N LINE,SSN
K VALMHDR
S LINE="Patient: "_$E($$GET1^DIQ(2,PSODFN,.01),1,25)
S SSN=$$GET1^DIQ(2,PSODFN,.09,"E")
S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
S $E(LINE,36)="("_SSN_")",$E(LINE,55)="DOB: "
S $E(LINE,60)=$$FMTE^XLFDT($$GET1^DIQ(2,PSODFN,.03),"5ZM")
S VALMHDR(1)="",VALMHDR(2)=LINE
S VALM("TITLE")="Remote Facilities Visited"
Q
;
INIT ; - Populates the body of ListMan
S VALMCNT=0
D BLDRDI,BLDSIT
S VALMSG="Enter ?? for more actions"
Q
;
BLDSIT ; - Build prescription details for remote site sites
N LC,CNT
K ^TMP("PSORSITE",$J)
S LC="",CNT=0
F S LC=$O(^TMP("PSORDIS",$J,LC)) Q:LC="" D
.S CNT=CNT+1,^TMP("PSORSITE",$J,CNT,0)=" "_LC
; if no remote sites, set display reasons
I '$D(^TMP("PSORSITE",$J)),$D(^TMP($J,"PSORDI",1)) S LC="" D
.F S LC=$O(^TMP($J,"PSORDI",LC)) Q:LC="" D
..S CNT=CNT+1,^TMP("PSORSITE",$J,CNT,0)=" "_$G(^TMP($J,"PSORDI",LC,0))
S VALMCNT=CNT
Q
;
BLDRDI ;Builds Medication Profile (remote) for display
N SEQ,PSORDI,LC,SEQ,LINE,DATA,DATA1,QTY,ISDT,LFDT,FSIG,SIG,SITE,SITEO
N STA,EXPDT
K ^TMP("PSORDI",$J),^TMP("PSORDIS",$J)
S PSORDI=$$RDI(PSODFN),SITEO=""
S (LC,SEQ)=0
F S LC=$O(^TMP($J,"PSORDI",PSODFN,LC)) Q:'LC D
.S DATA=$G(^TMP($J,"PSORDI",PSODFN,LC,0))
.S EXPDT=$P(DATA,"^",7),STA=$P(DATA,"^",5)
.S STA=$$STACHK(STA,EXPDT) I '+STA Q
.S STA=$P(STA,"^",2)
.S SITE=$P(DATA,"^") I SITE'=SITEO D
..I SITEO'="" S LINE="" D SETTMP
..S LINE=SITE D SETTMP
.S LINE=$E($P(DATA,"^",4),1,13),$E(LINE,15)=$E($P(DATA,"^",2),1,34)
.S $E(LINE,50)=$S(STA="DISCONTINUED":"DC",1:$E(STA))
.S QTY=$P($P(DATA,"^",6),";"),$E(LINE,53)=$J(QTY,4)
.S ISDT=$P(DATA,"^",8),LFDT=$P(DATA,"^",9)
.S $E(LINE,60)=$$FMTE^XLFDT(ISDT,"5ZM")
.S $E(LINE,70)=$$FMTE^XLFDT(LFDT,"5ZM")
.D SETTMP
.I SITE'="" S ^TMP("PSORDIS",$J,SITE)=""
.S SITEO=SITE
.I $D(^TMP($J,"PSORDI",PSODFN,LC,"SIG")) D
..K FSIG D GETSIG
..S LINE="",$E(LINE,15)="SIG: ",SIG=0
..F S SIG=$O(FSIG(SIG)) Q:'SIG D
...S $E(LINE,20)=FSIG(SIG)
...D SETTMP S LINE=""
.S LINE="",$E(LINE,15)="PROVIDER: "_$P(DATA,"^",11) D SETTMP
S ^TMP("PSORDI",$J,"REMOTE COUNT")=SEQ
K X,Y
Q
STACHK(ST,EXPDT) ;Status Check
;Input: ST - Status of prescription
; EXPDT - Expiration date or prescription
;
I ST="" Q 0
I (ST="DELETED")!(ST="NON-VERIFIED") Q 0
I "EXPIRED"[ST D I $$FMDIFF^XLFDT(DT,Y)>90 Q 0
.N %DT S %DT="X",X=EXPDT D ^%DT
S ST=$S(ST["DISCONTINUED":"DC",ST["HOLD":"HOLD",1:ST)
Q 1_"^"_ST
;
SETTMP ;Sets the ^TMP("PSORDI",$J global
S SEQ=SEQ+1,^TMP("PSORDI",$J,SEQ,0)=LINE
Q
GETSIG ;Get SIG for remote sites from ^TMP($J,"PSORDI",
N RSIG,I
F I=0:1 Q:'$D(^TMP($J,"PSORDI",PSODFN,LC,"SIG",I)) S RSIG(I+1)=^(I)
;
FMTSIG ;Format SIG from remote site and return in the FSIG array
N FFF,NNN,CNT,FVAR,FVAR1,FLIM,II
S (FVAR,FVAR1)="",II=1
K FSIG
F FFF=0:0 S FFF=$O(RSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(RSIG(FFF)," ") S CNT=CNT+1 D I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1
.S FVAR1=$P(RSIG(FFF)," ",CNT),FLIM=FVAR
.S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
I $G(FVAR)'="" S FSIG(II)=FVAR
I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
Q
;
RDI(DFN) ; This call gets patient prescription data from other hospitals and
; stores them in ^TMP($J,"PSORDI"
;
; Input: DFN - The patient DFN from the patient file.
; Output: ^TMP($J,"PSORDI", - patient medication data.
;
N PSORET,PSOMED,PSOSIG,PSOSTAT,PSOSTR,LN,FAC,DRG,CNT
K ^TMP($J,"PSORDI"),^TMP("PSOREMOTE",$J)
I '$G(DFN) D Q 0
.S ^TMP($J,"PSORDI",1,0)="Invalid Patient IEN."
I '$$HAVEHDR^ORRDI1 D Q 0
.S ^TMP($J,"PSORDI",1,0)="Remote Data from HDR not available."
I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q 0
.S ^TMP($J,"PSORDI",1,0)="WARNING: Connection to Remote Data Currently Down."
S PSORET=$$GETRDI(DFN)
I PSORET=-1 D Q 0
.S ^TMP($J,"PSORDI",1,0)="Connection to Remote Data Not Available."
I '$D(^XTMP("ORRDI","PSOO",DFN)) D Q 0
.S ^TMP($J,"PSORDI",1,0)="No Remote Data available for this patient."
;
PARSE S (LN,PSOMED)=0
F S PSOMED=$O(^XTMP("ORRDI","PSOO",DFN,PSOMED)) Q:'+PSOMED D
.S PSOSTAT=$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,5,0))
.S PSOSTR=$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,1,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,2,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,3,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,4,0))_"^"
.S PSOSTR=PSOSTR_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,5,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,6,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,7,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,8,0))_"^"
.S PSOSTR=PSOSTR_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,9,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,10,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,11,0))_"^"_$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,12,0))
.S FAC=$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,1,0))
.S DRG=$G(^XTMP("ORRDI","PSOO",DFN,PSOMED,2,0))
.S FAC=$S(FAC="":"**UNKNOWN**",1:$E(FAC,1,30))
.S DRG=$S(DRG="":"**UNKNOWN**",1:$E(DRG,1,30))
.S LN=LN+1,^TMP("PSOREMOTE",$J,DFN,FAC,DRG,LN,0)=PSOSTR,PSOSIG=""
.F S PSOSIG=$O(^XTMP("ORRDI","PSOO",DFN,PSOMED,14,PSOSIG)) Q:PSOSIG="" S ^TMP("PSOREMOTE",$J,DFN,FAC,DRG,LN,"SIG",PSOSIG)=^(PSOSIG)
I '$D(^TMP("PSOREMOTE",$J,DFN)) D Q 0
.S ^TMP($J,"PSORDI",1,0)="No Active Remote Medications for this patient."
S FAC="",CNT=0
F S FAC=$O(^TMP("PSOREMOTE",$J,DFN,FAC)) Q:FAC="" S DRG="" D
.F S DRG=$O(^TMP("PSOREMOTE",$J,DFN,FAC,DRG)) Q:DRG="" S LN=0 D
..F S LN=$O(^TMP("PSOREMOTE",$J,DFN,FAC,DRG,LN)) Q:'LN D
...S CNT=CNT+1,^TMP($J,"PSORDI",DFN,CNT,0)=^TMP("PSOREMOTE",$J,DFN,FAC,DRG,LN,0)
...M ^TMP($J,"PSORDI",DFN,CNT,"SIG")=^TMP("PSOREMOTE",$J,DFN,FAC,DRG,LN,"SIG")
K ^TMP("PSOREMOTE",$J)
RDIOUT Q 1
;
GETRDI(DFN) ; call to get remote data
N RDI
S RDI=$$GET^ORRDI1(DFN,"PSOO")
Q $G(RDI)
;
RDICHK(PSODFN) ;Check for remote prescriptions
;Input - PSODFN Patient internal entry number
;
N DIR,X,Y
I '$$RDI(PSODFN) Q
W !!,"REMOTE PRESCRIPTIONS AVAILABLE!"
S DIR(0)="Y",DIR("A")="Display Remote Data",DIR("B")="N"
D ^DIR W ! I 'Y Q
D EN(PSODFN)
Q
;
REMOTE ; Listman display of remote prescriptions
I '$D(^TMP("PSORDI",$J)) D BLDRDI
D EN^PSORMRXD("DO")
Q
;
BOTH ; Listman display of remote and local prescriptions
D EN^PSORMRXD("DB")
Q
;
HELP ;
Q
;
EXIT ;
K ^TMP("PSORDI",$J),^TMP($J,"PSORDI"),^TMP("PSORSITE",$J)
K ^TMP("PSORDIS",$J),PSORFLG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORMRX 6856 printed Sep 23, 2025@20:10:29 Page 2
PSORMRX ;BIRM/JAM - REMOTE DATA INTEROPERABILITY UTILITY ; 10/29/08
+1 ;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
+2 ;;
+3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+4 ;
+5 ;References to ORRDI1 supported by DBIA 4659
+6 ;
EN(PSODFN) ;- ListManager entry point
+1 ;
+2 SET PSORFLG=1
+3 DO EN^VALM("PSO RDI VISITS")
+4 DO FULL^VALM1
+5 GOTO EXIT
+6 ;
HDR ; Patient Header for remote site
+1 NEW LINE,SSN
+2 KILL VALMHDR
+3 SET LINE="Patient: "_$EXTRACT($$GET1^DIQ(2,PSODFN,.01),1,25)
+4 SET SSN=$$GET1^DIQ(2,PSODFN,.09,"E")
+5 SET SSN=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+6 SET $EXTRACT(LINE,36)="("_SSN_")"
SET $EXTRACT(LINE,55)="DOB: "
+7 SET $EXTRACT(LINE,60)=$$FMTE^XLFDT($$GET1^DIQ(2,PSODFN,.03),"5ZM")
+8 SET VALMHDR(1)=""
SET VALMHDR(2)=LINE
+9 SET VALM("TITLE")="Remote Facilities Visited"
+10 QUIT
+11 ;
INIT ; - Populates the body of ListMan
+1 SET VALMCNT=0
+2 DO BLDRDI
DO BLDSIT
+3 SET VALMSG="Enter ?? for more actions"
+4 QUIT
+5 ;
BLDSIT ; - Build prescription details for remote site sites
+1 NEW LC,CNT
+2 KILL ^TMP("PSORSITE",$JOB)
+3 SET LC=""
SET CNT=0
+4 FOR
SET LC=$ORDER(^TMP("PSORDIS",$JOB,LC))
if LC=""
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET ^TMP("PSORSITE",$JOB,CNT,0)=" "_LC
End DoDot:1
+6 ; if no remote sites, set display reasons
+7 IF '$DATA(^TMP("PSORSITE",$JOB))
IF $DATA(^TMP($JOB,"PSORDI",1))
SET LC=""
Begin DoDot:1
+8 FOR
SET LC=$ORDER(^TMP($JOB,"PSORDI",LC))
if LC=""
QUIT
Begin DoDot:2
+9 SET CNT=CNT+1
SET ^TMP("PSORSITE",$JOB,CNT,0)=" "_$GET(^TMP($JOB,"PSORDI",LC,0))
End DoDot:2
End DoDot:1
+10 SET VALMCNT=CNT
+11 QUIT
+12 ;
BLDRDI ;Builds Medication Profile (remote) for display
+1 NEW SEQ,PSORDI,LC,SEQ,LINE,DATA,DATA1,QTY,ISDT,LFDT,FSIG,SIG,SITE,SITEO
+2 NEW STA,EXPDT
+3 KILL ^TMP("PSORDI",$JOB),^TMP("PSORDIS",$JOB)
+4 SET PSORDI=$$RDI(PSODFN)
SET SITEO=""
+5 SET (LC,SEQ)=0
+6 FOR
SET LC=$ORDER(^TMP($JOB,"PSORDI",PSODFN,LC))
if 'LC
QUIT
Begin DoDot:1
+7 SET DATA=$GET(^TMP($JOB,"PSORDI",PSODFN,LC,0))
+8 SET EXPDT=$PIECE(DATA,"^",7)
SET STA=$PIECE(DATA,"^",5)
+9 SET STA=$$STACHK(STA,EXPDT)
IF '+STA
QUIT
+10 SET STA=$PIECE(STA,"^",2)
+11 SET SITE=$PIECE(DATA,"^")
IF SITE'=SITEO
Begin DoDot:2
+12 IF SITEO'=""
SET LINE=""
DO SETTMP
+13 SET LINE=SITE
DO SETTMP
End DoDot:2
+14 SET LINE=$EXTRACT($PIECE(DATA,"^",4),1,13)
SET $EXTRACT(LINE,15)=$EXTRACT($PIECE(DATA,"^",2),1,34)
+15 SET $EXTRACT(LINE,50)=$SELECT(STA="DISCONTINUED":"DC",1:$EXTRACT(STA))
+16 SET QTY=$PIECE($PIECE(DATA,"^",6),";")
SET $EXTRACT(LINE,53)=$JUSTIFY(QTY,4)
+17 SET ISDT=$PIECE(DATA,"^",8)
SET LFDT=$PIECE(DATA,"^",9)
+18 SET $EXTRACT(LINE,60)=$$FMTE^XLFDT(ISDT,"5ZM")
+19 SET $EXTRACT(LINE,70)=$$FMTE^XLFDT(LFDT,"5ZM")
+20 DO SETTMP
+21 IF SITE'=""
SET ^TMP("PSORDIS",$JOB,SITE)=""
+22 SET SITEO=SITE
+23 IF $DATA(^TMP($JOB,"PSORDI",PSODFN,LC,"SIG"))
Begin DoDot:2
+24 KILL FSIG
DO GETSIG
+25 SET LINE=""
SET $EXTRACT(LINE,15)="SIG: "
SET SIG=0
+26 FOR
SET SIG=$ORDER(FSIG(SIG))
if 'SIG
QUIT
Begin DoDot:3
+27 SET $EXTRACT(LINE,20)=FSIG(SIG)
+28 DO SETTMP
SET LINE=""
End DoDot:3
End DoDot:2
+29 SET LINE=""
SET $EXTRACT(LINE,15)="PROVIDER: "_$PIECE(DATA,"^",11)
DO SETTMP
End DoDot:1
+30 SET ^TMP("PSORDI",$JOB,"REMOTE COUNT")=SEQ
+31 KILL X,Y
+32 QUIT
STACHK(ST,EXPDT) ;Status Check
+1 ;Input: ST - Status of prescription
+2 ; EXPDT - Expiration date or prescription
+3 ;
+4 IF ST=""
QUIT 0
+5 IF (ST="DELETED")!(ST="NON-VERIFIED")
QUIT 0
+6 IF "EXPIRED"[ST
Begin DoDot:1
+7 NEW %DT
SET %DT="X"
SET X=EXPDT
DO ^%DT
End DoDot:1
IF $$FMDIFF^XLFDT(DT,Y)>90
QUIT 0
+8 SET ST=$SELECT(ST["DISCONTINUED":"DC",ST["HOLD":"HOLD",1:ST)
+9 QUIT 1_"^"_ST
+10 ;
SETTMP ;Sets the ^TMP("PSORDI",$J global
+1 SET SEQ=SEQ+1
SET ^TMP("PSORDI",$JOB,SEQ,0)=LINE
+2 QUIT
GETSIG ;Get SIG for remote sites from ^TMP($J,"PSORDI",
+1 NEW RSIG,I
+2 FOR I=0:1
if '$DATA(^TMP($JOB,"PSORDI",PSODFN,LC,"SIG",I))
QUIT
SET RSIG(I+1)=^(I)
+3 ;
FMTSIG ;Format SIG from remote site and return in the FSIG array
+1 NEW FFF,NNN,CNT,FVAR,FVAR1,FLIM,II
+2 SET (FVAR,FVAR1)=""
SET II=1
+3 KILL FSIG
+4 FOR FFF=0:0
SET FFF=$ORDER(RSIG(FFF))
if 'FFF
QUIT
SET CNT=0
FOR NNN=1:1:$LENGTH(RSIG(FFF)," ")
SET CNT=CNT+1
Begin DoDot:1
+5 SET FVAR1=$PIECE(RSIG(FFF)," ",CNT)
SET FLIM=FVAR
+6 SET FVAR=$SELECT(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
End DoDot:1
IF $LENGTH(FVAR)>52
SET FSIG(II)=FLIM_" "
SET II=II+1
SET FVAR=FVAR1
+7 IF $GET(FVAR)'=""
SET FSIG(II)=FVAR
+8 IF $GET(FSIG(1))=""!($GET(FSIG(1))=" ")
SET FSIG(1)=$GET(FSIG(2))
KILL FSIG(2)
+9 QUIT
+10 ;
RDI(DFN) ; This call gets patient prescription data from other hospitals and
+1 ; stores them in ^TMP($J,"PSORDI"
+2 ;
+3 ; Input: DFN - The patient DFN from the patient file.
+4 ; Output: ^TMP($J,"PSORDI", - patient medication data.
+5 ;
+6 NEW PSORET,PSOMED,PSOSIG,PSOSTAT,PSOSTR,LN,FAC,DRG,CNT
+7 KILL ^TMP($JOB,"PSORDI"),^TMP("PSOREMOTE",$JOB)
+8 IF '$GET(DFN)
Begin DoDot:1
+9 SET ^TMP($JOB,"PSORDI",1,0)="Invalid Patient IEN."
End DoDot:1
QUIT 0
+10 IF '$$HAVEHDR^ORRDI1
Begin DoDot:1
+11 SET ^TMP($JOB,"PSORDI",1,0)="Remote Data from HDR not available."
End DoDot:1
QUIT 0
+12 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
Begin DoDot:1
+13 SET ^TMP($JOB,"PSORDI",1,0)="WARNING: Connection to Remote Data Currently Down."
End DoDot:1
QUIT 0
+14 SET PSORET=$$GETRDI(DFN)
+15 IF PSORET=-1
Begin DoDot:1
+16 SET ^TMP($JOB,"PSORDI",1,0)="Connection to Remote Data Not Available."
End DoDot:1
QUIT 0
+17 IF '$DATA(^XTMP("ORRDI","PSOO",DFN))
Begin DoDot:1
+18 SET ^TMP($JOB,"PSORDI",1,0)="No Remote Data available for this patient."
End DoDot:1
QUIT 0
+19 ;
PARSE SET (LN,PSOMED)=0
+1 FOR
SET PSOMED=$ORDER(^XTMP("ORRDI","PSOO",DFN,PSOMED))
if '+PSOMED
QUIT
Begin DoDot:1
+2 SET PSOSTAT=$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,5,0))
+3 SET PSOSTR=$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,1,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,2,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,3,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,4,0))_"^"
+4 SET PSOSTR=PSOSTR_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,5,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,6,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,7,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,8,0))_"^"
+5 SET PSOSTR=PSOSTR_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,9,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,10,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,11,0))_"^"_$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,12,0))
+6 SET FAC=$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,1,0))
+7 SET DRG=$GET(^XTMP("ORRDI","PSOO",DFN,PSOMED,2,0))
+8 SET FAC=$SELECT(FAC="":"**UNKNOWN**",1:$EXTRACT(FAC,1,30))
+9 SET DRG=$SELECT(DRG="":"**UNKNOWN**",1:$EXTRACT(DRG,1,30))
+10 SET LN=LN+1
SET ^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG,LN,0)=PSOSTR
SET PSOSIG=""
+11 FOR
SET PSOSIG=$ORDER(^XTMP("ORRDI","PSOO",DFN,PSOMED,14,PSOSIG))
if PSOSIG=""
QUIT
SET ^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG,LN,"SIG",PSOSIG)=^(PSOSIG)
End DoDot:1
+12 IF '$DATA(^TMP("PSOREMOTE",$JOB,DFN))
Begin DoDot:1
+13 SET ^TMP($JOB,"PSORDI",1,0)="No Active Remote Medications for this patient."
End DoDot:1
QUIT 0
+14 SET FAC=""
SET CNT=0
+15 FOR
SET FAC=$ORDER(^TMP("PSOREMOTE",$JOB,DFN,FAC))
if FAC=""
QUIT
SET DRG=""
Begin DoDot:1
+16 FOR
SET DRG=$ORDER(^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG))
if DRG=""
QUIT
SET LN=0
Begin DoDot:2
+17 FOR
SET LN=$ORDER(^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG,LN))
if 'LN
QUIT
Begin DoDot:3
+18 SET CNT=CNT+1
SET ^TMP($JOB,"PSORDI",DFN,CNT,0)=^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG,LN,0)
+19 MERGE ^TMP($JOB,"PSORDI",DFN,CNT,"SIG")=^TMP("PSOREMOTE",$JOB,DFN,FAC,DRG,LN,"SIG")
End DoDot:3
End DoDot:2
End DoDot:1
+20 KILL ^TMP("PSOREMOTE",$JOB)
RDIOUT QUIT 1
+1 ;
GETRDI(DFN) ; call to get remote data
+1 NEW RDI
+2 SET RDI=$$GET^ORRDI1(DFN,"PSOO")
+3 QUIT $GET(RDI)
+4 ;
RDICHK(PSODFN) ;Check for remote prescriptions
+1 ;Input - PSODFN Patient internal entry number
+2 ;
+3 NEW DIR,X,Y
+4 IF '$$RDI(PSODFN)
QUIT
+5 WRITE !!,"REMOTE PRESCRIPTIONS AVAILABLE!"
+6 SET DIR(0)="Y"
SET DIR("A")="Display Remote Data"
SET DIR("B")="N"
+7 DO ^DIR
WRITE !
IF 'Y
QUIT
+8 DO EN(PSODFN)
+9 QUIT
+10 ;
REMOTE ; Listman display of remote prescriptions
+1 IF '$DATA(^TMP("PSORDI",$JOB))
DO BLDRDI
+2 DO EN^PSORMRXD("DO")
+3 QUIT
+4 ;
BOTH ; Listman display of remote and local prescriptions
+1 DO EN^PSORMRXD("DB")
+2 QUIT
+3 ;
HELP ;
+1 QUIT
+2 ;
EXIT ;
+1 KILL ^TMP("PSORDI",$JOB),^TMP($JOB,"PSORDI"),^TMP("PSORSITE",$JOB)
+2 KILL ^TMP("PSORDIS",$JOB),PSORFLG
+3 QUIT
