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

PSORMRX.m

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