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

PSOORAL3.m

Go to the documentation of this file.
  1. PSOORAL3 ;BHAM ISC/MV - Build Listman activity log extension ; 12/4/07 12:25pm
  1. ;;7.0;OUTPATIENT PHARMACY;**643**;DEC 1997;Build 35
  1. ACT ;activity log
  1. N CNT,PSORDATA,PSOTXT,PSOTXT1,PSOTXT2,X
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Activity Log:"
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date/Time Reason Rx Ref Initiator Of Activity",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
  1. I '$O(^PSRX(DA,"A",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Activity to report" Q
  1. S CNT=0
  1. F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N S P1=^(N,0) D
  1. .I $P(P1,"^",2)="M" Q
  1. .S PSORDATA="",PSOTXT="",PSOTXT1="",PSOTXT2=""
  1. .S DAT=$$FMTE^XLFDT($P(P1,"^"),2)_" "
  1. .S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_$S(CNT<10:" ",1:" ")_$E(DAT,1,21),$P(RN," ",15)=" ",REA=$P(P1,"^",2)
  1. .S REA=$F("HUCELPRWSIVDABXGKNO",REA)-1
  1. .I REA D
  1. ..S STA=$P("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^IERX^","^",REA)
  1. ..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,15)
  1. .E S $P(STA," ",15)=" ",^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA
  1. .K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)
  1. .S RFT=$S(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")
  1. .S PSORDATA=$$REMDATA(DA,P1)
  1. .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$E(RN,$L(RFT)+1,15)_$E($S($P(PSORDATA,"^",2)]"":$P(PSORDATA,"^",2),$D(^VA(200,+$P(P1,"^",3),0)):$P(^(0),"^"),1:$P(P1,"^",3)),1,24)
  1. .I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D
  1. ..K PSOTXT S PSOACBRV=$P(P1,"^",5)_$P(PSORDATA,"^")
  1. ..I (($L(PSOACBRV)#59)<$L($P(PSORDATA,"^"))),($P(PSORDATA,"^")]"") S PSOACBRV=$P(P1,"^",5),PSOTXT=" "_$P(PSORDATA,"^")
  1. ..K ^UTILITY($J,"W") S X=PSOACBRV,(DIWR,DIWL)=1,DIWF="C69" D ^DIWP F I=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$S(I=1:"Comments: ",1:" ")_$G(^UTILITY($J,"W",1,I,0))
  1. ..I $G(PSOTXT)]"" S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=PSOTXT K PSOTXT
  1. ..S PSOTXT1=$P(PSORDATA,"^",6),PSOTXT2=$P(PSORDATA,"^",5)
  1. ..I $P(P1,U,2)="N" D
  1. ...I $L(PSOTXT1_PSOTXT2)>25 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Filled By: "_PSOTXT1,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Checking Pharmacist: "_PSOTXT2
  1. ...I ($L(PSOTXT1_PSOTXT2)<26),($L(PSOTXT1_PSOTXT2)>1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Filled By: "_$S(PSOTXT1="":" ",1:PSOTXT1)_" Checking Pharmacist: "_PSOTXT2
  1. .I $P($G(^PSRX(DA,"A",N,1)),"^")]"" S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",5)=$P($G(^PSRX(DA,"A",N,1)),"^") I $P($G(^PSRX(DA,"A",N,1)),"^",2)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_":"_$P($G(^PSRX(DA,"A",N,1)),"^",2)
  1. .I $O(^PSRX(DA,"A",N,2,0)) F I=0:0 S I=$O(^PSRX(DA,"A",N,2,I)) Q:'I S MIG=^PSRX(DA,"A",N,2,I,0) D
  1. ..S:MIG["Mail Tracking Info.: " IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" "
  1. ..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)
  1. K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR
  1. Q
  1. ;
  1. REMDATA(PSOIEN,P1) ;
  1. ;Check if activity log needs to display the remote pharmacist (OneVA)
  1. ;P1 - ^PSRX(D0,"A",D1,0)
  1. NEW PSOPF,PSOCHK,PSORMTE,PSORPH,PSOP2,PSOP3,PSOP4,PSOFLG
  1. Q:+'$G(PSOIEN) ""
  1. Q:$G(P1)="" ""
  1. S PSOPF=0,PSOP2=$P(P1,U,2),PSOP3=$P(P1,U,3),PSOP4=$P(P1,U,4)
  1. S PSOFLG=$S($P(P1,U,5)["HL7 ID":1,1:0)
  1. I $S(PSOP2="P":1,PSOP2="X":1,PSOP2="N":1,1:0),$S(PSOP4=6:1,PSOP4=0:1,PSOP2="P":1,1:0) S PSOCHK=$$PFCHK(PSOIEN,$P(P1,U),,PSOFLG) Q:PSOCHK]"" PSOCHK
  1. I $S(PSOP2="X":1,PSOP2="N":1,1:0),$S(((PSOP4>0)&(PSOP4<6)):+PSOP4,((PSOP4>6)&(PSOP4<13)):1,1:0) S PSOCHK=$$RFCHK(PSOIEN,PSOP4,PSOFLG)
  1. Q $G(PSOCHK)
  1. ;
  1. RFCHK(PSOIEN,PSOP4,PSOFLG) ;
  1. NEW PSOX1,PSOX2,PSOXRF,PSOXDIC4,PSOXRF,PSORFDT,PSOSNUM,PSOSNUMX,PSOSNAME
  1. Q:'+$G(PSOIEN) ""
  1. Q:'+$G(PSOP4) ""
  1. I PSOP4>6 S PSOP4=PSOP4-1
  1. S PSOXRF=$G(^PSRX(PSOIEN,1,PSOP4,"RF")),PSOSNUM=$P(PSOXRF,U)
  1. S PSOSNAME="",PSOX1=""
  1. I PSOSNUM]"" S PSOSNAME=$$STATION(PSOSNUM)
  1. S:PSOSNAME]"" PSOX1=$S(+$G(PSOFLG):" at ",1:" Processed at ")_PSOSNAME
  1. S PSOX2=PSOX1_U_$P(PSOXRF,U,2,6)
  1. Q $G(PSOX2)
  1. ;
  1. PFCHK(PSOIEN,PSODT,PSOLBL,PSOFLG) ;
  1. ;PSODT - LBLDATA set this date to 7 digit length so it can match to the "PF" OneVA .01 field.
  1. ;PSOLBL - 1 if calling from LBLDATA
  1. ;PSOX2 - Site name (station #) ^ remote pharmacist
  1. NEW PSOX,PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4,PSOPFDT,PSOSNUMX,PSOSNAME,PSOX1
  1. Q:'+$G(PSOIEN) ""
  1. Q:$G(PSODT)="" ""
  1. ;Using the 52.02,01 PARTIAL DATE because OneVA partial fill can't back dated.
  1. F PSOX=0:0 S PSOX=$O(^PSRX(PSOIEN,"P",PSOX)) Q:'PSOX D Q:$G(PSOX2)]""
  1. .S PSOPFDT=$P($G(^PSRX(PSOIEN,"P",PSOX,0)),U)
  1. .I $S(PSOPFDT=PSODT:1,PSOPFDT=$E(PSODT,1,7):1,1:0) D
  1. ..K PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4
  1. ..S PSOXPF=$G(^PSRX(PSOIEN,"P",PSOX,"PF")),PSOSNUM=$P(PSOXPF,U)
  1. ..S PSOSNAME="",PSOX1=""
  1. ..S PSOSNAME=$$STATION(PSOSNUM)
  1. ..S:PSOSNAME]"" PSOX1=$S($G(PSOLBL):" Printed at ",1:$S(+$G(PSOFLG):" at ",1:" Processed at "))_PSOSNAME
  1. ..S PSOX2=PSOX1_U_$P(PSOXPF,U,2,6)
  1. Q $G(PSOX2)
  1. ;
  1. LBLDATA(PSOIEN,LBL) ;
  1. NEW PSORDATA,PSOLBLDT,PSORN,PSOX1,PSOLBLDT,PSOTXT,PSOSNAME
  1. Q:+'$G(PSOIEN) ""
  1. Q:$G(LBL)="" ""
  1. ;check if label entry is related to a refill
  1. S PSOTXT="",PSORDATA="",PSORN=+$P(LBL,U,2),PSOLBLDT=$P(LBL,U)
  1. I (PSORN>0),(PSORN<12) D
  1. .S PSOX1=$G(^PSRX(PSOIEN,1,PSORN,"RF"))
  1. .S PSOSNAME=$$STATION($P(PSOX1,U))
  1. .S:PSOSNAME]"" PSOTXT=" Printed at "_PSOSNAME
  1. .S PSORDATA=PSOTXT_U_$P(PSOX1,U,2,6)
  1. ;If there's no Refill with the same date as the label log date, check the partial fill entries.
  1. I PSORN,($G(PSORDATA)="") S PSORDATA=$$PFCHK(PSOIEN,PSOLBLDT,1)
  1. Q PSORDATA
  1. ;
  1. STATION(PSOSNUM) ;
  1. NEW PSOXDIC4,PSOTXT
  1. Q:$G(PSOSNUM)="" ""
  1. D F4^XUAF4(PSOSNUM,.PSOXDIC4)
  1. I $G(PSOXDIC4("NAME"))]"" S PSOTXT=PSOXDIC4("NAME")_" ("_PSOSNUM_")"
  1. Q $G(PSOTXT)
  1. ;