183 lines
8.8 KiB
Mathematica
183 lines
8.8 KiB
Mathematica
PSOHLDIS ;BIR/PWC,SAB - Automated Dispense Completion HL7 v.2.4 ;10/20/06 3:39pm
|
|
;;7.0;OUTPATIENT PHARMACY;**156,189,193,209,148,259,200**;DEC 1997;Build 7
|
|
;Reference to ^PSDRUG supported by DBIA #221
|
|
;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707
|
|
;This routine is called by FACK1^PSOHLDS
|
|
;
|
|
;*209 add Drug accountability & fix Copay for refills
|
|
;*259 check for refill node to exist before updating the Release msg
|
|
;
|
|
EN ;main entry and process
|
|
N NONODE
|
|
D GETHL7,GETPID,GETORC,GETRXD
|
|
;
|
|
;Begin Updating files ;*259
|
|
I MEDDISP D ;if dispensed
|
|
. I FLL="F",'FLLN D FILL ;orig fill
|
|
. I FLL="F",FLLN D REFILL ;refill
|
|
. I FLL="P" D PARTIAL ;partial fill
|
|
. D ACTLOG ;activity log
|
|
. Q:$G(NONODE) ;quit, no refill node to update
|
|
. I $D(BGRP),$D(BNAM),$D(BDIV) D BINGREL^PSOHLDI1 ;bingo board rel
|
|
. D DRGACCT^PSOHLDI1(RXID) ;drug accountability *209
|
|
. I '$G(PRT) D CHKADDR^PSODISPS(RXID)
|
|
E D ;else not dispensed
|
|
. D ACTLOG ;activity log no release
|
|
;
|
|
;if label was printed
|
|
I PRT D
|
|
. S LBI=0 F LB=0:0 S LB=$O(^PSRX(RXID,"L",LB)) Q:'LB S LBI=LBI+1
|
|
. S LBI=LBI+1,^PSRX(RXID,"L",0)="^52.032DA^"_LBI_"^"_LBI
|
|
. S ^PSRX(RXID,"L",LBI,0)=NOW_"^"_$S(FLL="F":FLLN,1:(99-FLLN))_"^"_"From Rx # "_$P(^PSRX(RXID,0),"^")_$S(FLL="P":" (Partial)",1:"")_$S($G(HLRPT):" (Reprint)",1:"")_" (External Interface)"_"^"_HLUSER
|
|
;
|
|
D END
|
|
Q
|
|
;
|
|
GETHL7 ;get HL7 segments from msg
|
|
K OK
|
|
F I=0:0 S I=$O(PSOMSG(I)) Q:'I D
|
|
.I $P(PSOMSG(I),"|")="MSH" S NODE1=PSOMSG(I) Q
|
|
.I $P(PSOMSG(I),"|")="MSA" S NODE2=PSOMSG(I) Q
|
|
.I $P(PSOMSG(I),"|")="PID" S NODE3=PSOMSG(I) Q
|
|
.I $P(PSOMSG(I),"|")="ORC" S NODE4=PSOMSG(I) Q
|
|
.I $P(PSOMSG(I),"|")="RXD" S NODE5=PSOMSG(I) Q
|
|
Q
|
|
;
|
|
GETPID ;get PID segment data
|
|
S PID=$P($G(NODE3),"|",4) ;this contains all the patient id numbers
|
|
F XX=1:1 S PIDD=$P(PID,"^",XX) Q:PIDD="" D
|
|
. S PIDID=$P(PIDD,"~",5)
|
|
. I PIDID="NI" S PICN=$P(PIDD,"~",1) ;ICN #
|
|
. I PIDID="SS" S PSSN=$P(PIDD,"~",1) ;SSN #
|
|
. I PIDID="PI" S PPID=$P(PIDD,"~",1) ;patient ID
|
|
. I PIDID="PN" S PCLM=$P(PIDD,"~",1) ;claim #
|
|
Q
|
|
GETORC ;get ORC segment data
|
|
S RXID=$P($P($G(NODE4),"|",3),"^") ;RX #
|
|
S DFN=$P(^PSRX(RXID,0),"^",2) D DEM^VADPT
|
|
S NAME=VADM(1),DOB=$P(VADM(3),"^"),SEX=$P(VADM(5),"^") K VADM
|
|
S FPER=$P($P($G(NODE4),"|",11),"~") ;filling person
|
|
K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+FPER D
|
|
.D ^DIC I +Y>0 S FPER=+Y,FPERN=$P(Y,"^",2) Q
|
|
.S FPER="",FPERN="UNKNOWN"
|
|
S CPHARM=$P($P($G(NODE4),"|",12),"~") ;checking pharmacist
|
|
K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+CPHARM D K DIC,X,Y
|
|
.D ^DIC I +Y>0 S CPHARM=+Y,CPHARMN=$P(Y,"^",2) Q
|
|
.S CPHARM="",CPHARMN="UNKNOWN"
|
|
Q
|
|
GETRXD ;get RXD segment data
|
|
S FILL=$P($P($G(NODE5),"|",2),"^") ;fill #
|
|
S GIVECOD=$P($P($G(NODE5),"|",3),"^") ;give code
|
|
S X=$P($P($G(NODE5),"|",4),"^"),DISPDT=$$FMDATE^HLFNC(X) K X ;dispense date
|
|
S PSORX=$P($P($G(NODE5),"|",8),"^") ;prescription #
|
|
S NDC=$P($P($G(NODE5),"|",10),"^") ;NDC #
|
|
K F I NDC]"" D K L,F
|
|
.S F=""
|
|
.F L=1:1:$L(NDC,"^") I $P(NDC,"^",L)'="" S F=$G(F)_$P(NDC,"^",L)_$S($P(NDC,"^",(L+1))]"":",",1:"")
|
|
.S NDC=F
|
|
S X=$P($P($G(NODE5),"|",10),"^",2),RELDT=$S($$FMDATE^HLFNC(X)>0:$$FMDATE^HLFNC(X),1:"") K X ;release dt
|
|
S PRT=$S($P($P($G(NODE5),"|",10),"^",3)=1:1,$P($P($G(NODE5),"|",10),"^",3)=2:1,1:0) ;label printed by vendor
|
|
S MEDDISP=$S($P($P($G(NODE5),"|",10),"^",3)=1:1,$P($P($G(NODE5),"|",10),"^",3)=4:1,1:0) ;med dispensed by vendor
|
|
S RPHARM=$P($P($G(NODE5),"|",11),"~",1) ;releasing pharmacist
|
|
K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+RPHARM D
|
|
.D ^DIC I +Y>0 S RPHARM=+Y Q
|
|
.S RPHARM=""
|
|
S LOT=$P($G(NODE5),"|",19)
|
|
I LOT]"" D K L,F
|
|
.S F=""
|
|
.F L=1:1:$L(LOT,"^") I $P(LOT,"^",L)'="" S F=$G(F)_$P(LOT,"^",L)_$S($P(LOT,"^",(L+1))]"":",",1:"")
|
|
.S LOT=F
|
|
S X=$P($P($G(NODE5),"|",20),"^"),EXPDT=$S($$FMDATE^HLFNC(X)>0:$$FMDATE^HLFNC(X),1:"") K X ;expiration date
|
|
S MFG=$P($P($G(NODE5),"|",21),"^") ;manufacturer
|
|
K F I MFG]"" D K L,F
|
|
.F L=1:1:$L(MFG) Q:$P(MFG,"^",L)="" S F=$G(F)_$P(MFG,"^",L)_$S($P(MFG,"^",(L+1))]"":",",1:"")
|
|
.S MFG=F
|
|
S EXRX=^PS(52.51,EIN,0)
|
|
S IRX=$P(EXRX,"^"),FLL=$P(EXRX,"^",8),FLLN=$P(EXRX,"^",9),RPT=$P(EXRX,"^",5),(DIV,PSOSITE)=$P(EXRX,"^",11),PSOPAR=$G(^PS(59,DIV,0))
|
|
S PSOPAR7=$G(^PS(59,PSOSITE,"IB")),PSOSYS=$G(^PS(59.7,1,40.1))
|
|
S RXN=$P(^PSRX(IRX,0),"^"),DRG=$P(^(0),"^",6),QTY=$P(^(0),"^",7)
|
|
Q
|
|
FILL ;Orig fill
|
|
S $P(^PSRX(IRX,2),"^",4)=LOT,$P(^(2),"^",8)=MFG,$P(^(2),"^",11)=EXPDT,$P(^PSRX(IRX,"OR1"),"^",6)=FPER,$P(^("OR1"),"^",7)=CPHARM
|
|
S:$G(^PSDRUG(DRG,660.1))]"" ^PSDRUG(DRG,660.1)=^PSDRUG(DRG,660.1)-QTY
|
|
;if auto release & rel dt
|
|
I $P($G(^PS(59,DIV,"DISP")),"^",2),$G(RELDT) D
|
|
.S DIE="^PSRX(",DA=IRX,DR="31///"_RELDT_";23////"_RPHARM_";32.1///@;32.2///@" D ^DIE K DIE,DR,DA
|
|
.I $P(^PSRX(IRX,0),"^",11)["W" S BRT="W",BNAM=$P(^PSRX(IRX,0),"^",2),BDIV=$P(^(2),"^",9) S:BDIV'="" BGRP=$P($G(^PS(59,BDIV,1)),"^",20)
|
|
.S PSOCPRX=$P(^PSRX(IRX,0),"^"),RXP=IRX D CP^PSOCP
|
|
.D EN^PSOHLSN1(IRX,"ZD"),AUTOREL^PSOBPSUT(IRX,FLLN,RELDT,NDC,"A",,30)
|
|
;else if not auto release nor rel dt
|
|
E I $$NDCFMT^PSSNDCUT(NDC)'="",$$STATUS^PSOBPSUT(IRX,FLLN)="" D SAVNDC^PSONDCUT(IRX,FLLN,NDC)
|
|
Q
|
|
REFILL ;refill
|
|
I '$D(^PSRX(IRX,1,FLLN,0)) S NONODE=1 Q
|
|
S $P(^PSRX(IRX,1,FLLN,0),"^",6)=LOT,$P(^(0),"^",14)=MFG,$P(^(0),"^",15)=EXPDT,$P(^(1),"^",4)=FPER,$P(^(1),"^",5)=CPHARM
|
|
S:$G(^PSDRUG(DRG,660.1))]"" ^PSDRUG(DRG,660.1)=^PSDRUG(DRG,660.1)-$P(^PSRX(IRX,1,FLLN,0),"^",4)
|
|
I $P($G(^PS(59,DIV,"DISP")),"^",2),$G(RELDT) D
|
|
.S DIE="^PSRX("_IRX_","""_1_""",",DA(1)=IRX,DA=FLLN
|
|
.S DR="17///"_RELDT_";4////"_RPHARM D ^DIE K DIE,DR,DA
|
|
.I $P(^PSRX(IRX,1,FLLN,0),"^",2)["W" S BRT="W",BDIV=$P(^PSRX(IRX,1,FLLN,0),"^",9),BNAM=$P(^PSRX(IRX,0),"^",2) S:BDIV'="" BGRP=$P($G(^PS(59,BDIV,1)),"^",20)
|
|
.N YY S YY=FLLN ;*209
|
|
.S PSOCPRX=$P(^PSRX(IRX,0),"^"),RXP=IRX D CP^PSOCP
|
|
.D EN^PSOHLSN1(IRX,"ZD"),AUTOREL^PSOBPSUT(IRX,FLLN,RELDT,NDC,"A",,30)
|
|
;else if not auto release nor rel dt
|
|
E I $$NDCFMT^PSSNDCUT(NDC)'="",$$STATUS^PSOBPSUT(IRX,FLLN)="" D SAVNDC^PSONDCUT(IRX,FLLN,NDC)
|
|
Q
|
|
PARTIAL ;partial fill dispensed
|
|
I '$D(^PSRX(IRX,"P",FLLN,0)) S NONODE=1 Q
|
|
S $P(^PSRX(IRX,"P",FLLN,0),"^",6)=LOT,$P(^(0),"^",12)=NDC,$P(^PSRX(IRX,"P",FLLN,1),"^")=MFG,$P(^(1),"^",3)=FPER,$P(^(1),"^",4)=CPHARM
|
|
S:$G(^PSDRUG(DRG,660.1))]"" ^PSDRUG(DRG,660.1)=^PSDRUG(DRG,660.1)-$P(^PSRX(IRX,"P",FLLN,0),"^",4)
|
|
I $P($G(^PS(59,DIV,"DISP")),"^",2),$G(RELDT) D
|
|
.S DIE="^PSRX("_IRX_","""_"P"_""",",DA(1)=IRX,DA=FLLN
|
|
.S DR="8///"_RELDT_";.05////"_RPHARM D ^DIE K DIE,DR,DA
|
|
.I $P(^PSRX(IRX,"P",FLLN,0),"^",2)["W" S BRT="W",BDIV=$P(^PSRX(IRX,"P",FLLN,0),"^",9),BNAM=$P(^PSRX(IRX,0),"^",2) S:BDIV'="" BGRP=$P($G(^PS(59,BDIV,1)),"^",20)
|
|
Q
|
|
ACTLOG ;activity log entry
|
|
N ATXT,ACTN,RXF
|
|
S:FLL="F" RXF=$S(FLLN>5:FLLN+1,1:FLLN)
|
|
S:FLL="P" RXF=6
|
|
S ACL=0 F I=0:0 S I=$O(^PSRX(RXID,"A",I)) Q:'I S ACL=(ACL+1)
|
|
D NOW^%DTC S NOW=%,ACL=ACL+1,^PSRX(RXID,"A",0)="^52.3DA^"_ACL_"^"_ACL
|
|
I 'MEDDISP S ATXT="Medication WAS NOT Dispensed through Interface!"
|
|
;
|
|
;create activity log text
|
|
I MEDDISP D
|
|
. S ATXT="External Interface Dispensing is Complete."
|
|
. I $G(NONODE) D Q ;node was deleted
|
|
. . S ATXT="External Interface attempted to Release, but "
|
|
. . S ATXT=ATXT_$S(FLL="P":"Partial fill",1:"Refill")_" NOT on file."
|
|
. . S ACTN="No update performed."
|
|
. . D MAIL^PSOHLDI1
|
|
. I $G(^PSRX(RXID,"STA"))>11 D Q ;non-active status
|
|
. . S ATXT="Ext. Disp. Released this Rx, which is Status of "
|
|
. . S ATXT=ATXT_$$GET1^DIQ(52,RXID,100)
|
|
. . S ACTN=""
|
|
. . D MAIL^PSOHLDI1
|
|
S ^PSRX(RXID,"A",ACL,0)=NOW_"^N^"_RPHARM_"^"_RXF_"^"_ATXT
|
|
;
|
|
;other comments - additional info when dispensed
|
|
I MEDDISP D
|
|
.S ^PSRX(RXID,"A",ACL,2,0)="^52.34A^2^2"
|
|
.S ^PSRX(RXID,"A",ACL,2,1,0)="Filled By: "_FPERN
|
|
.S ^PSRX(RXID,"A",ACL,2,2,0)="Checking Pharmacist: "_CPHARMN
|
|
Q
|
|
ERROR ;sends the error message back to the sending station
|
|
;parse the data from the msh segment in order to send back the error message release
|
|
;OK=1 - segment missing
|
|
;OK=2 - Rx does not exists
|
|
D NOW^%DTC
|
|
S REJ=$S(OK=1:"MISSING SEGMENT(S)",OK=2:"PRESCRIPTION "_$S($G(PSORX):"#: "_PSORX,1:"")_" DOES NOT EXISTS",1:"")
|
|
S ACKDATE=$P($$FMTHL7^XLFDT(%),"-",1)
|
|
S ^TMP("PSO2",$J,1)="MSH|^~\&|PSO VISTA||PSO DISPENSE||"_$G(ACKDATE)_"||RDS^013|10001|P|2.4|||NE|NE"
|
|
;S ^TMP("PSO2",$J,2)="MFE|MUP|"_$G(J)_"|"_$G(ACKDATE)_"|"_$G(SITE)_"|CE"
|
|
;S ^TMP("PSO2",$J,3)="ZLF|4|^"_$G(USER)_"||"_$G(REJ)
|
|
K %,ACKDATE,USER,Y,REJ,OK
|
|
Q
|
|
END K ACL,I,NOW,LBI,LB,PRT,MEDDISP
|
|
K ADA,BDA,BDIV,BNGRXP,BNGSUS,BNAME,BRX,CNT1,CT,DA,DD,DIC,DIE,DIK,DIR,DO,DR,DTOUT,DUOUT,GRP,GRTP,JOES
|
|
K NAM,NDA,NFLAG,NME,ODA,PSZ,RXO,SSN,TDFN,TFLAG,TIC,TICK,TIEN,TM,TM1,TSSN,X,Y,XX,BNAM,BRT,BGRP
|
|
K Y,OK,XQADATA,SITEN,RDOM,CMOP,REQT,RTDTM,SITENUM,XQSOP,XQMSG,SITEN,NAME,XQAMSG,SITEN
|
|
K XQAROU,XQAID,RDTM,NODE1,NODE2,NODE3,NODE4,NODE5,PIDID,PIDD,PICN,PSSN,PPID,PCLM
|
|
K CPHARM,CPHARMN,FPER,FPERN,RPHARM
|
|
Q
|