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

PSNJP54.m

Go to the documentation of this file. 
  1. PSNJP54 ;BIR/JCH-INPATIENT REPORT ;20 Nov 01 / 10:15 AM
  1.  ;;4.0; NATIONAL DRUG FILE;**54,61,63**; 30 Oct 98
  1.  ;
  1.  ; Reference to ^PS(52.6 is supported by DBIA 1231.
  1.  ; Reference to ^PS(52.7 is supported by DBIA 2173.
  1.  ; Reference to ^PS(55 is supported by DBIA 2191.
  1.  ; Reference to ^PSDRUG is supported by DBIA 2192.
  1.  ;                                           
  1. EN ; Main entry point
  1.  N EXIT,PNAME,STDT,ENDT,RUNDT,OUTFORM,BEGDT,DOB,DPT0,ORTYP,PID
  1.  N PRODNAM,PSGORD,SCHTYP,SOLDRUG,STPDT,STPDT,TYP1,TYP2,VAPROD,INACTFLG
  1.  D INIT Q:'$G(DUZ)
  1.  S EXIT=0 D GETDATE Q:EXIT  ;Get beginning and ending dates
  1.  D FORMAT Q:$D(DIRUT)    ; Report or Spreadsheet format
  1.  S ZTDESC="Inpatient Medications Missed Drug Interactions Report"
  1.  S ZTRTN="START^PSNJP54"
  1.  F G="BEGDT","ENDT","OUTFORM" S:$D(@G) ZTSAVE(G)=""
  1.  D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) Q
  1.  ;
  1. START ; Begin processing
  1.  ;Begin $O'ing through ^PS(55,DFN - (every patient)
  1.  I '$$PATCH^XPDUTL("PSN*4.0*54") D EN^DDIOL("Patch PSN*4.0*54 must be installed before this report can be run.","","!") Q
  1.  I '$D(^XTMP("PSNINT")) W !,"The primary data for this report does not exist",!! Q
  1.  S PSJPG=1,RUNDT=DT D HD
  1.  N BEGDTF,ENDTF,PNAME,DFN,DIRUT,TCNT S TCNT=0
  1.  S ENDTF=ENDT_".999999",BEGDTF=BEGDT-.01,RUNDT=DT K ^TMP("PSN PSNJ54"),^TMP("PSN PSNJ54I")
  1.  S DFN=0 F  S DFN=$O(^PS(55,DFN)) Q:'DFN!$D(DIRUT)  D PROCESS Q:$D(DIRUT)
  1.  I OUTFORM'="S" W ?12,"END OF ACTIVE DRUG INTERACTIONS",! D HD
  1.  S INACTFLG=1 D INACTOUT
  1.  I 'TCNT W !!?10,"** No Missed Drug Interactions Found **"
  1.  Q
  1.  ;
  1. PROCESS ; Begin processing a single patient
  1.  N INTER,PROD,DONE,CNT
  1.  S PSJDT=BEGDTF,ORTYP="U" D GETUD
  1.  S PSJDT=BEGDTF,ORTYP="I" D GETIV
  1.  S PROD=0 F  S PROD=$O(PROD(PROD)) Q:'PROD!$D(DIRUT)  D
  1.  .S VAPROD=PROD F  S VAPROD=$O(PROD(VAPROD)) Q:'VAPROD!$D(DIRUT)  D
  1.  ..Q:'$D(^XTMP("PSNINT",PROD,VAPROD))!$D(DIRUT)
  1.  ..D CHK(PROD,VAPROD)
  1.  Q
  1.  ;
  1. GETUD ; Build VA Products from Unit Dose Orders into PROD array
  1.  N STDT,PSGORD,DDSEQ,STDT,DDRUG,VAPROD
  1.  F  S PSJDT=$O(^PS(55,DFN,5,"AUS",PSJDT)) Q:PSJDT>ENDTF!('PSJDT)  D
  1.  .S PSGORD=0
  1.  .F  S PSGORD=$O(^PS(55,DFN,5,"AUS",PSJDT,PSGORD)) Q:'PSGORD  D
  1.  ..S DDSEQ=0 F  S DDSEQ=$O(^PS(55,DFN,5,PSGORD,1,DDSEQ)) Q:'DDSEQ  D
  1.  ...S DDRUG=+$G(^PS(55,DFN,5,PSGORD,1,DDSEQ,0))
  1.  ...S STDT=$G(^PS(55,DFN,5,PSGORD,2)),STPDT=$P(STDT,"^",4),STDT=$P(STDT,"^",2)
  1.  ...Q:'DDRUG  S VAPROD=$P($G(^PSDRUG(DDRUG,"ND")),"^",3)
  1.  ...Q:'VAPROD  Q:'$D(^XTMP("PSNINT",VAPROD))
  1.  ...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
  1.  Q
  1.  ;
  1. GETIV ; Build VA Products from IV Orders into PROD array
  1.  N ADD,SOL,ADSEQ,SOLSEQ,ADDRUG,VAPROD
  1.  F  S PSJDT=$O(^PS(55,DFN,"IV","AIS",PSJDT)) Q:PSJDT>ENDTF!('PSJDT)  D
  1.  .S PSGORD=0
  1.  .F  S PSGORD=$O(^PS(55,DFN,"IV","AIS",PSJDT,PSGORD)) Q:'PSGORD  D
  1.  ..S STDT=$G(^PS(55,DFN,"IV",PSGORD,0))
  1.  ..S STPDT=$P(STDT,"^",3),STDT=$P(STDT,"^",2)
  1.  ..S ADSEQ=0
  1.  ..F  S ADSEQ=$O(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ)) Q:'ADSEQ  D
  1.  ...S ADD=$P($G(^PS(55,DFN,"IV",PSGORD,"AD",ADSEQ,0)),"^")
  1.  ...S ADDRUG=$P($G(^PS(52.6,ADD,0)),"^",2)
  1.  ...Q:'ADDRUG  S VAPROD=$P($G(^PSDRUG(ADDRUG,"ND")),"^",3)
  1.  ...Q:'VAPROD  Q:'$D(^XTMP("PSNINT",VAPROD))
  1.  ...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
  1.  ..S SOLSEQ=0
  1.  ..F  S SOLSEQ=$O(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ)) Q:'SOLSEQ  D
  1.  ...S SOL=$P($G(^PS(55,DFN,"IV",PSGORD,"SOL",SOLSEQ,0)),"^")
  1.  ...S SOLDRUG=$P($G(^PS(52.7,SOL,0)),"^",2)
  1.  ...Q:'SOLDRUG  S VAPROD=$P($G(^PSDRUG(SOLDRUG,"ND")),"^",3)
  1.  ...Q:'VAPROD  Q:'$D(^XTMP("PSNINT",VAPROD))
  1.  ...S PROD(VAPROD,ORTYP,PSGORD)=(STDT\1)_"^"_(STPDT\1)
  1.  Q
  1.  ;
  1. CHK(PR1,PR2) ; Given two VA PRODUCTS known to interact (exist in ^XTMP)
  1.  ;  find specific interactions within a single patient's orders
  1.  ;  based on overlapping START/STOP dates.
  1.  ;
  1.  N DT,ORD,TYP,START1,START2,STOP1,STOP2
  1.  D GETVITAL(DFN)
  1.  S TYP1="" F  S TYP1=$O(PROD(PR1,TYP1)) Q:TYP1=""!$D(DIRUT)  D
  1.  .S ORD1=0 F  S ORD1=$O(PROD(PR1,TYP1,ORD1)) Q:'ORD1!$D(DIRUT)  D
  1.  ..S TYP2="" F  S TYP2=$O(PROD(PR2,TYP2)) Q:TYP2=""!$D(DIRUT)  D
  1.  ...S ORD2=0 F  S ORD2=$O(PROD(PR2,TYP2,ORD2)) Q:'ORD2!$D(DIRUT)  D
  1.  ....N INACT S INACT=0
  1.  ....S START1=PROD(PR1,TYP1,ORD1),STOP1=$P(START1,"^",2),START1=+START1
  1.  ....S START2=PROD(PR2,TYP2,ORD2),STOP2=$P(START2,"^",2),START2=+START2
  1.  ....I (START1>START2)!(START1=START2) I START1<STOP2 D DISP(START1) Q
  1.  ....I (START2>START1)!(START2=START1) I START2<STOP1 D DISP(START2) Q
  1.  Q
  1.  ;
  1. DISP(START) ; Display an interaction between two VA PRODUCTS
  1.  N SEVER,INTCNT,INTNAM,INTIEN,INTDATA
  1.  I ($Y+6)>IOSL D HD Q:$D(DIRUT)  K CNT
  1.  S INTCNT=0 F  S INTCNT=$O(^XTMP("PSNINT",PR1,PR2,INTCNT)) Q:'INTCNT!$D(DIRUT)  D
  1.  .S INTDATA=$G(^XTMP("PSNINT",PR1,PR2,INTCNT))
  1.  .S INTIEN=$P(INTDATA,"^")
  1.  .D CHKINACT(START,INTIEN,INTCNT) Q:INACT
  1.  .D DISP2
  1.  Q
  1.  ;
  1. DISP2 ;
  1.  S CNT=$G(CNT)+1,TCNT=$G(TCNT)+1
  1.  I (OUTFORM'="S") D  Q:$D(DIRUT)
  1.  .I CNT=1 W !,PNAME,?25,"DOB: ",DOB,?41,"PID: ",PID
  1.  .I ($Y+6)>IOSL D HD
  1.  I OUTFORM="S" W !,PNAME,"^",DOB,"^",PID,"^"
  1.  S SEVER=$P(INTDATA,"^",5),INTNAM=$P(INTDATA,"^",2)
  1.  S SEVER=$S($G(SEVER)=1:"Critical",$G(SEVER)=2:"Significant",1:"Unknown")
  1.  I OUTFORM'="S" W !?1,"Interaction: ",INTNAM,?49,"  Severity: ",SEVER  D
  1.  .I INACT W !?1,"Interaction Inactivation Date: ",$$FMTE^XLFDT(INACT,2)
  1.  I OUTFORM="S" W INTNAM_"^"_SEVER_"^" W:INACT $$FMTE^XLFDT(INACT,2) W "^"
  1.  D ORDOUT(DFN,PR1,TYP1,ORD1,START1,STOP1)
  1.  D ORDOUT(DFN,PR2,TYP2,ORD2,START2,STOP2)
  1.  W:OUTFORM'="S" !
  1.  Q
  1.  ;
  1. INACTOUT ;
  1.  ;
  1.  W ! W:OUTFORM'="S" ?10,"START OF INACTIVE DRUG INTERACTIONS" W !
  1.  N DFN,ORD1,ORD2,PR1,PR2,TYP1,TYP2,STOP1,STOP2,DATA,DIRUT,INTCNT
  1.  S DFN=0 F  S DFN=$O(^TMP("PSN PSNJ54I",$J,DFN)) Q:'DFN!$D(DIRUT)  D
  1.  .S PR1=0 F  S PR1=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1)) Q:'PR1!$D(DIRUT)  D
  1.  ..S PR2="" F  S PR2=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2)) Q:'PR2!$D(DIRUT)  D
  1.  ...S ORD1="" F  S ORD1=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1)) Q:'ORD1!$D(DIRUT)  D
  1.  ....S ORD2="" F  S ORD2=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2)) Q:'ORD2!$D(DIRUT)  D
  1.  .....S INTCNT=""
  1.  .....F  S INTCNT=$O(^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2,INTCNT)) Q:'INTCNT!$D(DIRUT)  D
  1.  ......S DATA=^(INTCNT),TYP1=$P(DATA,"^"),TYP2=$P(DATA,"^",2),INACT=$P(DATA,"^",7)
  1.  ......S START1=$P(DATA,"^",3),START2=$P(DATA,"^",4)
  1.  ......S STOP1=$P(DATA,"^",5),STOP2=$P(DATA,"^",6)
  1.  ......S INTDATA=$G(^XTMP("PSNINT",PR1,PR2,INTCNT))
  1.  ......D GETVITAL(DFN) D DISP2
  1.  Q
  1.  ;
  1. ORDOUT(DFN,PRODUCT,TYPE,ORDER,START,STOP) ; Print an individual order
  1.  S ND0=^PS(55,DFN,$S(TYPE="U":5,1:"IV"),ORDER,0),SCHTYP=$P(ND0,"^",7)
  1.  S PRODNAM=$P($G(^PSNDF(50.68,PRODUCT,0)),"^")
  1.  I OUTFORM'="S" D  Q  ;  Regular Report Format
  1.  .W !?3,ORDER,TYPE,?8,$E(PRODNAM,1,25) I PRODNAM["(",PRODNAM'[")" W ")"
  1.  .W ?36,SCHTYP,?43,$$FMTE^XLFDT(START\1,2),?53,$$FMTE^XLFDT(STOP\1,2)
  1.  W ORDER,"^",TYPE,"^",PRODNAM,"^",SCHTYP,"^",$$FMTE^XLFDT(START\1,2),"^"
  1.  W $$FMTE^XLFDT(STOP\1,2)
  1.  Q
  1.  ;
  1. GETVITAL(DFN) ;
  1.  S DPT0=^DPT(DFN,0),PNAME=$P(DPT0,"^"),DOB=$P(DPT0,"^",3),PID=$P(DPT0,"^",9)
  1.  S DOB=$$FMTE^XLFDT(DOB,2),PID=$TR($J($P(DPT0,"^",9),9)," ",0)
  1.  S PID=$E(PID,1,3)_"-"_$E(PID,4,5)_"-"_$E(PID,6,9)
  1.  Q
  1.  ;
  1. CHKINACT(START,IIEN,XTMPCNT) ;
  1.  N INACTDT
  1.  S INACTDT=$P(^PS(56,IIEN,0),"^",7)
  1.  Q:'INACTDT
  1.  Q:INACTDT>START
  1.  S STRING=TYP1_"^"_TYP2_"^"_START1_"^"_START2_"^"_STOP1_"^"_STOP2_"^"_INACTDT_"^"_XTMPCNT
  1.  S ^TMP("PSN PSNJ54I",$J,DFN,PR1,PR2,ORD1,ORD2,XTMPCNT)=STRING
  1.  S INACT=1
  1.  Q
  1.  ;
  1. GETDATE ; Prompt for  "Stop Date" to begin search
  1.  N NEXT S NEXT=""
  1.  W !?5,"This report searches Inpatient Medications orders by" D
  1.  .W !?5,"STOP DATE, looking for drug interactions based on the"
  1.  .W !?5,"data in ^XTMP(""PSNINT"",VA PRODUCT,VA PRODUCT)"
  1.  .W !!,"Default starting date is one year ago."
  1.  S X1=DT,X2=-365 D C^%DTC S D=X
  1.  S D=$$FMTE^XLFDT(D)
  1.  S Y=-1 F  W !!,"Enter starting date: "_D_" // " R X:DTIME S:X="" X=D D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) S:Y<0 EXIT=1 Q
  1.  I $G(EXIT) W !,"No starting date chosen" Q
  1.  S BEGDT=Y,ENDT=DT+10000 D:+$E(Y,6,7)=0 DTC
  1.  Q
  1.  ;
  1. DTM W !!,"Enter the Order Stop Date to begin searching from: "
  1.  W !!
  1.  Q
  1.  ;
  1.  ;
  1. FORMAT ; Prompt for "Report" or "Spreadsheet" format
  1.  N DIR,STRING
  1.  S DIR(0)="SB^R:REPORT;S:SPREADSHEET",DIR("B")="Report"
  1.  S DIR("A")="Select a format for your data"
  1.  D ^DIR Q:$D(DIRUT)
  1.  S OUTFORM=Y
  1.  I OUTFORM="S" S STRING="PATIENT NAME^DATE OF BIRTH^PATIENT ID^" D
  1.  .S STRING=STRING_"DESCRIPTION OF INTERACTION^SEVERITY OF INTERACTION^"
  1.  .S STRING=STRING_"INACTIVATION DATE OF INTERACTION^ORDER NUMBER 1^"
  1.  .S STRING=STRING_"ORDER TYPE 1^VA PRODUCT 1^SCHEDULE TYPE 1^START TIME 1^STOP TIME 1^"
  1.  .S STRING=STRING_"STOP TIME 1^ORDER NUMBER 2^ORDER TYPE 2^VA PRODUCT 2^"
  1.  .S STRING=STRING_"SCHEDULE TYPE 2^START TIME 2^STOP TIME 2"
  1.  .W !!,"Format of Data elements, delimited by '^' :"
  1.  .F I=1:1:$L(STRING,"^") W !,I,") ",?5,$P(STRING,"^",I)
  1.  Q
  1.  ;
  1. HD ;  Continue prompt, print header
  1.  Q:OUTFORM="S"
  1.  I PSJPG>1,$E(IOST)="C" S DIR(0)="E" D
  1.  .S DIR("A")="Press Return to Continue or ""^"" to quit"
  1.  .D ^DIR K DIR W !
  1.  Q:$D(DIRUT)
  1.  I $E(IOST)="C" W @IOF
  1.  W:$G(INACTFLG) ?16,"*INACTIVE* "
  1.  W ?22,"Inpatient Drug Interaction Report" D
  1.  .W ?72,"Page "_PSJPG
  1.  .W !?20,"Run Date: ",$$FMTE^XLFDT(RUNDT)
  1.  W !?1,"Order",?8,"VA Product Name"
  1.  W ?33,"Sch Type",?44,"Start",?54,"Stop"
  1.  W ! F Y=1:1:75 W "-"
  1.  W ! S PSJPG=PSJPG+1
  1.  Q
  1.  ;
  1. INIT ; Check for DT,DUZ,etc.
  1.  K ^UTILITY($J)
  1.  I '$G(DUZ)!'$D(DTIME)!'$G(DT) D  Q
  1.  .W !?5,"You must run ^XUP before running this report." Q
  1.  I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
  1.  S RUNDT=DT,DTOUT=0
  1.  D RESETDT
  1.  Q
  1.  ;
  1. RESETDT ;
  1.  S X=+$G(^XTMP("PSNINT",0))
  1.  I X S X=$$FMADD^XLFDT(DT,90) S $P(^XTMP("PSNINT",0),"^")=X
  1.  Q
  1.  ;
  1. DTC ;Date format
  1.  N DD,MM S DD=31,MM=+$E(Y,4,5)
  1.  I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D
  1.  .D ^%DTC S DD=X
  1.  S ENDT=Y+DD
  1.  Q