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

PSORMRXD.m

Go to the documentation of this file.
  1. PSORMRXD ;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. EN(PSOSEL) ;- ListManager entry point
  1. ;
  1. D EN^VALM("PSO RDI VISITS DETAIL")
  1. D FULL^VALM1
  1. G EXIT
  1. ;
  1. HDR ; Patient Header for remote site
  1. D HDR^PSORMRX
  1. I PSOSEL="DO" S VALM("TITLE")="Medication Profile - Remote"
  1. I PSOSEL="DB" S VALM("TITLE")="Medication Profile - Both"
  1. Q
  1. ;
  1. INIT ; - Populates the Body section for ListMan
  1. S VALMCNT=0
  1. D DETAIL
  1. S VALMSG="Enter ?? for more actions"
  1. Q
  1. ;
  1. DETAIL ; Build prescription details for local site
  1. N SEQ,ST,DRG,DATA,NODE0,NODE1,PSOX,ISDT,QTY,LFDT,PSOSD,PSODTCUT,LINE,RX
  1. N FSIG,PRVDR,SIG,STA,LC,CNT
  1. ; - get the last sequence number for remote prescriptions
  1. S SEQ=$O(^TMP("PSORDI",$J,"A"),-1)
  1. I PSOSEL="DO" S VALMCNT=$S(SEQ:SEQ,1:1) D Q
  1. .; if no remote sites, set display reasons if available
  1. .I '+$O(^TMP("PSORDI",$J,0)),$D(^TMP($J,"PSORDI",1)) S LC="",CNT=0 D
  1. ..F S LC=$O(^TMP($J,"PSORDI",LC)) Q:LC="" D
  1. ...S CNT=CNT+1,^TMP("PSORDI",$J,CNT,0)=" "_$G(^TMP($J,"PSORDI",LC,0))
  1. ; get local prescriptions
  1. S PSODTCUT=$$FMADD^XLFDT(DT,-90)
  1. D ^PSOBUILD
  1. I +SEQ<1 S SEQ=0
  1. I SEQ>1 S LINE="" D SETTMP
  1. I $D(PSOSD) D
  1. .S LINE="LOCAL PRESCRIPTIONS" D SETTMP
  1. S (LINE,ST)=""
  1. F S ST=$O(PSOSD(ST)) Q:ST="" D
  1. .S (LINE,DRG)="" F S DRG=$O(PSOSD(ST,DRG)) Q:DRG="" D
  1. ..S DATA=PSOSD(ST,DRG)
  1. ..S NODE0=$G(^PSRX(+$P(DATA,"^"),0)),LFDT=+$G(^(3)) I NODE0="" Q
  1. ..S STA=$$STACHK^PSORMRX(ST,$P($G(^PSRX(+$P(DATA,"^"),2)),"^",6))
  1. ..I '+STA Q
  1. ..S STA=$P(STA,"^",2)
  1. ..S LINE=$P(NODE0,"^"),$E(LINE,15)=$E(DRG,1,34)
  1. ..S $E(LINE,50)=$S(STA="DISCONTINUED":"DC",1:$E(STA))
  1. ..S QTY=$P(NODE0,"^",7),ISDT=$P(NODE0,"^",13)
  1. ..S $E(LINE,53)=$J(+QTY,4),$E(LINE,60)=$$FMTE^XLFDT(ISDT,"2ZM")
  1. ..F PSOX=0:0 S PSOX=$O(^PSRX(+$P(DATA,"^"),1,PSOX)) Q:'PSOX D
  1. ...S NODE1=$G(^PSRX(+$P(DATA,"^"),1,PSOX,0))
  1. ...I +NODE1=LFDT,$P(NODE1,"^",16) S LFDT=LFDT_"^R"
  1. ..I '$O(^PSRX(+$P(DATA,"^"),1,0)),$P($G(^PSRX(+$P(DATA,"^"),2)),"^",15) D
  1. ...S LFDT=LFDT_"^R"
  1. ..S $E(LINE,70)=$$FMTE^XLFDT(LFDT,"2ZM")
  1. ..D SETTMP
  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) D SETTMP S LINE=""
  1. ..I $O(FSIG(""))="" D SETTMP
  1. ..S PRVDR=$P($G(^PSRX(+$P(DATA,"^"),0)),"^",4),LINE=""
  1. ..S $E(LINE,15)="PROVIDER: "_$$UP^XLFSTR($$NAME^XUSER(PRVDR,"F"))
  1. ..D SETTMP S LINE=""
  1. S VALMCNT=SEQ
  1. Q
  1. ;
  1. SETTMP ;Sets the ^TMP("PSORDI",$J global
  1. S SEQ=SEQ+1,^TMP("PSORDI",$J,SEQ,0)=LINE
  1. Q
  1. ;
  1. GETSIG ;Gets SIG from File #52, format and place into FSIG array
  1. N I,RSIG
  1. S I=0 F S I=$O(^PSRX(+$P(DATA,"^"),"SIG1",I)) Q:'I D
  1. .S RSIG(I)=$G(^PSRX(+$P(DATA,"^"),"SIG1",I,0))
  1. I $O(RSIG(""))'="" D FMTSIG^PSORMRX
  1. Q
  1. ;
  1. HELP ;
  1. Q
  1. ;
  1. EXIT ;
  1. ;Remove local but leave remote prescriptions
  1. N CNT,SEQ
  1. I '$D(PSORFLG) D Q
  1. .K ^TMP("PSORDI",$J),^TMP($J,"PSORDI"),^TMP("PSORDIS",$J)
  1. S SEQ=$G(^TMP("PSORDI",$J,"REMOTE COUNT"))
  1. F S SEQ=$O(^TMP("PSORDI",$J,SEQ)) Q:'SEQ K ^TMP("PSORDI",$J,SEQ)
  1. Q