- 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 Feb 19, 2025@00:00:28 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