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

PSOVDF1.m

Go to the documentation of this file.
  1. PSOVDF1 ;BPOIFO/EL-OUTPATIENT PHARMACY (PRES, PREF, PPAR) HL7 MESSAGE ;10/04/04
  1. ;;7.0;OUTPATIENT PHARMACY;**190,205,220,235,261**;DEC 1997;Build 9
  1. ;
  1. VALID ;;VDEF HL7 MESSAGE BUILDER
  1. ;
  1. ; DBIA #4248 - $$XCN200^VDEFEL (or <MultipleTag>^VDEFEL)
  1. ; DBIA #3552 - $$PARAM^HLCS2
  1. ; DBIA #3630 - BLDPID^VAFCQRY
  1. ; DBIA #10040 - 0-NODE of ^SC
  1. ; DBIA 4571 - ERR^VDEFREQ
  1. ;
  1. ; This routine is called at tag EN as a Function by VDEFREQ1
  1. ;
  1. Q
  1. ;
  1. EN(EVIEN,KEY,VFLAG,OUT,MSHP) ;
  1. ; This routine creates one of three Outpatient Pharmacy HL7 messages:
  1. ; RDE^O11^PRES, RDS^O13^PREF, or RDS^O13^PPAR
  1. ;
  1. ; Input Parameters:
  1. ; EVIEN - IEN of message in file 577
  1. ; KEY - IEN to File #52 ^PSRX
  1. ; VFLAG - "V" for VistA HL7 destination (default)
  1. ; OUT - Target array. Must be passed by reference
  1. ; MSHP - 4th piece is SUBTYPE (PRES, PREF, PPAR)
  1. ;
  1. ; Returns:
  1. ; Two piece string with separator '^':
  1. ; Piece 1 - "LM" - LOCAL ARRAY
  1. ; Piece 2 - MSH segment, is not set
  1. ; OUT - OUTPUT array includes HL7 message for every segment except MSH
  1. ;
  1. ; Message Body "MSH,PID,ORC1,RXE1,RXR1,FT1,OBX1,NTE1,ORC2,ORC3"
  1. ; The Pharmacy Original Fill message will be generated by pgm:PSOVDF2 - (ORC1. . NTE1)
  1. ;
  1. ;
  1. N CTR,PSOVDFD0,PSOVDFD1,DFN,DRCODE,PSOVDRUG,ERR,FILE,FIELD,GIVECODE,GL,GLOB,GLOBAL,HLINST,PSOVDDIV,PSOVD59,PSOVERR
  1. N I,L,MSG,NTE,P,RES,SEPC,SEPE,SEPF,SEPR,SEPS,SRC,SUBTYPE,TARGET,PSOVDFES,PSOVESC,PSOVDFIN
  1. N HL7DEL,REPSEPC,REPSEPE,REPSEPF,REPSEPR,REPSEPS,TEMP,TP,UNIT,VAL,WR,X,Y,Z,VCMP,VFT7
  1. ;
  1. S (ERR,TARGET)=""
  1. D INIT
  1. I $G(ERR)'="" D ERR^VDEFREQ(ERR) S ZTSTOP=1 G QUIT
  1. D MSHPID
  1. I $G(ERR)'="" D ERR^VDEFREQ(ERR) S ZTSTOP=1 G QUIT
  1. D PROCESS^PSOVDF2
  1. D ORC2
  1. QUIT Q TARGET
  1. ;
  1. INIT ;
  1. K GL,OUT,TEMP,TP
  1. S (PSOVDFD0,PSOVDFES,DFN,DRCODE,PSOVDRUG,FILE,GIVECODE,GLOB,SEPC,SEPE,SEPF,SEPR,SEPS,SRC,SUBTYPE,UNIT,VAL)=""
  1. S (HL7DEL,REPSEPC,REPSEPE,REPSEPF,REPSEPR,REPSEPS)=""
  1. S OUT("HLS")=0
  1. S PSOVDFD0=KEY
  1. I $G(U)'="^" S U="^"
  1. S FILE=52
  1. S SUBTYPE=$P($G(MSHP),"~",4)
  1. S VAL=$G(HL("ECH")) I VAL="" S VAL="~|\&",HL("ECH")=VAL
  1. S SEPE=$E(VAL,3),REPSEPE=SEPE_"E"_SEPE
  1. S SEPC=$E(VAL,1),REPSEPC=SEPE_"S"_SEPE
  1. S SEPR=$E(VAL,2),REPSEPR=SEPE_"R"_SEPE
  1. S SEPS=$E(VAL,4),REPSEPS=SEPE_"T"_SEPE
  1. S VAL=$G(HL("FS")) I VAL="" S VAL="^",HL("FS")=VAL
  1. S SEPF=$E(VAL,1),REPSEPF=SEPE_"F"_SEPE
  1. S HL7DEL=$G(HL("ECH"))_$G(HL("FS"))
  1. S GLOB=$$ROOT^DILFD(FILE)_PSOVDFD0_")"
  1. M GL=@GLOB
  1. S DFN=$P($G(GL(0)),U,2)
  1. I $G(DFN)="" S ERR="MISSING DFN IN FILE-52 AT IEN="_PSOVDFD0 Q
  1. I $G(^DPT(DFN,0))="" S ERR="MISSING DFN IN FILE-2 AT FILE-52/IEN="_PSOVDFD0 Q
  1. S PSOVDFES=$$REPL(PSOVDFD0)
  1. S PSOVDFIN=$$SITE^VASITE,PSOVDFIN=$P($G(PSOVDFIN),"^",2),PSOVDFIN=$$REPL(PSOVDFIN)
  1. Q
  1. ;
  1. PUT(P) ; Put in MSG
  1. I $G(VAL)="" Q
  1. S $P(MSG,SEPF,P)=VAL
  1. Q
  1. ;
  1. REPL(L) ; REPLACE HL7 DELIMITER CHAR
  1. I $G(L)="" Q ""
  1. I $TR(L,$G(HL7DEL))=L Q L
  1. N X,Y,Z,RES
  1. S RES=L
  1. I $F(L,SEPE) S X=RES D
  1. . S Z=$P(X,SEPE,2,9999),Y=$P(X,SEPE)_REPSEPE_Z,RES=Y,X=Z I '$F(Z,SEPE) Q
  1. . F I=2:1 S Z=$P(X,SEPE,2,9999),Y=$P(RES,REPSEPE,1,I-1)_REPSEPE_$P(X,SEPE)_REPSEPE_Z,RES=Y,X=Z I '$F(Z,SEPE) Q
  1. I $F(RES,SEPC) F I=1:1 S Y=$P(RES,SEPC)_REPSEPC_$P(RES,SEPC,2,9999),RES=Y I '$F(RES,SEPC) Q
  1. I $F(RES,SEPR) F I=1:1 S Y=$P(RES,SEPR)_REPSEPR_$P(RES,SEPR,2,9999),RES=Y I '$F(RES,SEPR) Q
  1. I $F(RES,SEPS) F I=1:1 S Y=$P(RES,SEPS)_REPSEPS_$P(RES,SEPS,2,9999),RES=Y I '$F(RES,SEPS) Q
  1. I $F(RES,SEPF) F I=1:1 S Y=$P(RES,SEPF)_REPSEPF_$P(RES,SEPF,2,9999),RES=Y I '$F(RES,SEPF) Q
  1. Q RES
  1. ;
  1. OUT D OUT^PSOVDF2 Q
  1. OUT20 D OUT20^PSOVDF2 Q
  1. ;
  1. MSHPID ;
  1. MSH ; MSH
  1. S (HLINST,MSG,SRC)=""
  1. I '$D(SITEPARM) S SITEPARM=$$PARAM^HLCS2
  1. S HLINST=$P(SITEPARM,U,6),HLINST=$$REPL(HLINST),SRC=HLINST_"_"_FILE
  1. S TARGET="LM"_SEPF_MSG
  1. ;
  1. PID ; PID
  1. K WR
  1. S (MSG)=""
  1. D BLDPID^VAFCQRY(DFN,1,"",.WR,.HL,.ERR)
  1. I $G(WR(1))="" S ERR="MISSING PID AT DFN="_DFN_" IN FILE-52 AT IEN="_PSOVDFD0 Q
  1. I $P(WR(1),U,3)="V" S $P(WR(1),U,3)=""
  1. D OUT20
  1. K WR
  1. Q
  1. ;
  1. ORC2 ; RF
  1. I '$D(GL(1)) G ORC3
  1. K TEMP M TEMP=GL(1)
  1. S PSOVDFD1=0
  1. ORC2A S PSOVDFD1=$O(TEMP(PSOVDFD1)) G ORC3:'PSOVDFD1
  1. S MSG=""
  1. S TP=$G(TEMP(PSOVDFD1,0)) I TP="" G ORC2A
  1. S PSOVESC=$$REPL(PSOVDFD1),VAL=PSOVESC D PUT(3)
  1. ; (7~4-10.1)
  1. S (VAL,WR)="",WR=$P(TP,U,19) I $G(WR)'="" D
  1. .S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL(WR),$P(VAL,SEPC,4)=WR,$P(VAL,SEPC,7)="DISPENSED"
  1. ; (7~5-13)
  1. S WR=$P(TP,U,15) I $G(WR)'="" D
  1. .S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL(WR),$P(VAL,SEPC,5)=WR,$P(VAL,SEPC,7)=$P(VAL,SEPC,7)_"/EXPIRATION"
  1. D PUT(7)
  1. S VAL="",$P(VAL,SEPC,2)=PSOVDFES D PUT(8)
  1. ; (9-7)
  1. S VAL=$P(TP,U,8) I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL(VAL) D PUT(9)
  1. ; (12-15)
  1. S VAL=$P(TP,U,17) I $G(VAL)'="" S VAL=$$XCN200^VDEFEL(VAL) D PUT(12)
  1. S VAL="REFILL" D PUT(16)
  1. S VAL=$P(TP,U,9) S:$G(VAL)="" VAL=$P($G(^PSRX(PSOVDFD0,2)),"^",9) I $G(VAL)'="" D
  1. .S PSOVD59=VAL I $D(PSOVDDIV(VAL)) S VAL=$G(PSOVDDIV(VAL)) S $P(VAL,SEPC,3)=$P($P(VAL,SEPC,3),"_")_"_52.1_8" D PUT(17) Q
  1. .N PSONCRF,PSONCRFP,PSOSTNUM
  1. .S X=$G(^PS(59,VAL,0)),PSONCRFP=$P($G(^("SAND")),"^",3)
  1. .S VAL=$P(X,U),(VAL,PSONCRF)=$$REPL(VAL) Q:VAL=""
  1. .S PSOSTNUM=$P(X,U,6),PSOSTNUM=$$REPL(PSOSTNUM)
  1. .S VAL=PSOSTNUM_SEPC_VAL_SEPC_HLINST_"_52.1_8"
  1. .I PSONCRFP'="" S PSONCRFP=$$REPL(PSONCRFP),VAL=VAL_SEPC_PSONCRFP_SEPC_PSONCRF_SEPC_"NCPDP"
  1. .S PSOVDDIV(PSOVD59)=$G(VAL)
  1. .D PUT(17)
  1. S VAL=$G(PSOVDFIN) D PUT(21)
  1. I $D(VCMP(PSOVDFD1)) S VAL=SEPC_SEPC_SEPC_VCMP(PSOVDFD1) D PUT(25)
  1. I $G(MSG)="" G ORC2Q
  1. S $P(MSG,U)="RF"
  1. S MSG="ORC"_SEPF_MSG D OUT
  1. ORC2Q ; Q
  1. ;
  1. RXE2 ; RF
  1. S MSG=""
  1. ; (1~4-.01)
  1. S (VAL,WR)="",WR=$P(TP,U,1) I $G(WR)'="" D
  1. .S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL(WR),$P(VAL,SEPC,4)=WR,$P(VAL,SEPC,7)="REFILL" D PUT(1)
  1. ; (2~1..~3-6, 2~4-API , 2~6-NDC)
  1. S VAL=""
  1. I $T(NDC^PSOHDR)]"" D
  1. .S VAL=$$NDC^PSOHDR(PSOVDFD0,PSOVDFD1,"R")
  1. E S VAL=$P($G(TEMP(PSOVDFD1,1)),U,3) D
  1. .I $G(VAL)="",$G(PSOVDRUG)'="" S VAL=$P($G(^PSDRUG(PSOVDRUG,2)),"^",4)
  1. I $G(VAL)'="" D
  1. .S VAL=$$REPL(VAL)
  1. .S X="",X=GIVECODE,$P(X,SEPC,4)=VAL,$P(X,SEPC,6)="NDC",VAL=X D PUT(2)
  1. E S VAL=GIVECODE D PUT(2)
  1. S VAL=0 D PUT(3)
  1. ; (5-DEF="UNK" or API)
  1. S VAL=UNIT D PUT(5)
  1. ; (8~6-2)
  1. S (VAL,WR)=""
  1. S WR=$$GET1^DIQ(52.1,PSOVDFD1_","_PSOVDFD0_",",2,"","","PSOVERR") K PSOVERR I $G(WR)'="" S WR=$$REPL(WR),$P(VAL,SEPC,6)=WR D PUT(8)
  1. ; (10-1)
  1. S VAL=$P(TP,U,4),VAL=$$REPL(VAL) D PUT(10)
  1. ; (14|1-4)
  1. S VAL=$P(TP,U,5) I $G(VAL)="" G RXE2A
  1. S VAL=$$XCN200^VDEFEL(VAL,"PHARMACIST") D PUT(14)
  1. ; (18-17)
  1. RXE2A S VAL=$P(TP,U,18) I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL(VAL) D PUT(18)
  1. ; (22-1.1)
  1. S VAL=$P(TP,U,10) I $G(VAL)'="" S VAL="D"_VAL,VAL=$$REPL(VAL) D PUT(22)
  1. D RXE31A^PSOVDF3
  1. D PUT(31)
  1. I $G(MSG)="" G RXE2Q
  1. S MSG="RXE"_SEPF_MSG D OUT
  1. RXE2Q ; Q
  1. ;
  1. NTE2 ; RF
  1. S MSG=""
  1. ; (3-52.1_3)
  1. S WR=$P(TP,U,3) I $G(WR)="" G NTE2Q
  1. S VAL=PSOVDFD1 D PUT(1)
  1. S VAL=$$REPL(WR)
  1. D PUT(3),RREM^PSOVDF3,PUT(4)
  1. S MSG="NTE"_SEPF_MSG D OUT
  1. NTE2Q ; Q
  1. ;
  1. FT12 ; RF
  1. ; patch 261 - FT1
  1. D FT1R^PSOVDF3
  1. FT12Q ; Q
  1. G ORC2A
  1. ;
  1. ORC3 ; PAR
  1. I '$D(GL("P")) Q
  1. K TEMP M TEMP=GL("P")
  1. S PSOVDFD1=0
  1. ORC3A S PSOVDFD1=$O(TEMP(PSOVDFD1)) Q:'PSOVDFD1
  1. S MSG=""
  1. S TP=$G(TEMP(PSOVDFD1,0)) I TP="" G ORC3A
  1. S PSOVESC=$$REPL(PSOVDFD1),VAL=PSOVESC D PUT(3)
  1. ; (7~4-7.5)
  1. S WR=$P(TP,U,13) I $G(WR)'="" D
  1. .S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL(WR),VAL="",$P(VAL,SEPC,4)=WR,$P(VAL,SEPC,7)="DISPENSED" D PUT(7)
  1. S VAL="",$P(VAL,SEPC,2)=PSOVDFES D PUT(8)
  1. ; (9-.08)
  1. S VAL=$P(TP,U,8) I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL(VAL) D PUT(9)
  1. ; (12-6)
  1. S VAL=$P(TP,U,17) I $G(VAL)'="" S VAL=$$XCN200^VDEFEL(VAL) D PUT(12)
  1. S VAL="PARTIAL" D PUT(16)
  1. S VAL=$P(TP,U,9) S:$G(VAL)="" VAL=$P($G(^PSRX(PSOVDFD0,2)),"^",9) I $G(VAL)'="" D
  1. .S PSOVD59=VAL I $D(PSOVDDIV(VAL)) S VAL=$G(PSOVDDIV(VAL)) S $P(VAL,SEPC,3)=$P($P(VAL,SEPC,3),"_")_"_52.2_.09" D PUT(17) Q
  1. .N PSONCPR,PSONCPRP,PSOSPNUM
  1. .S X=$G(^PS(59,VAL,0)),PSONCPRP=$P($G(^("SAND")),"^",3)
  1. .S VAL=$P(X,U),(VAL,PSONCPR)=$$REPL(VAL) Q:VAL=""
  1. .S PSOSPNUM=$P(X,U,6),PSOSPNUM=$$REPL(PSOSPNUM)
  1. .S VAL=PSOSPNUM_SEPC_VAL_SEPC_HLINST_"_52.2_.09"
  1. .I PSONCPRP'="" S PSONCPRP=$$REPL(PSONCPRP),VAL=VAL_SEPC_PSONCPRP_SEPC_PSONCPR_SEPC_"NCPDP"
  1. .S PSOVDDIV(PSOVD59)=$G(VAL)
  1. .D PUT(17)
  1. S VAL=$G(PSOVDFIN) D PUT(21)
  1. I $G(MSG)="" G ORC3Q
  1. S $P(MSG,U)="RF"
  1. S MSG="ORC"_SEPF_MSG D OUT
  1. ORC3Q ; Q
  1. ;
  1. RXE3 ; PAR
  1. S MSG=""
  1. ; (1~4-.01)
  1. S WR=$P(TP,U,1) I $G(WR)'="" D
  1. .S WR=$$HLDATE^HLFNC(WR,"TS") I WR>0 S WR=$$REPL(WR),VAL="",$P(VAL,SEPC,4)=WR,$P(VAL,SEPC,7)="PARTIAL" D PUT(1)
  1. ; (2~1..~3-6, 2~4-API, 2~6-NDC)
  1. S VAL=""
  1. I $T(NDC^PSOHDR)]"" D
  1. .S VAL=$$NDC^PSOHDR(PSOVDFD0,PSOVDFD1,"P")
  1. E S VAL=$P($G(TEMP(PSOVDFD1,0)),U,12) D
  1. .I $G(VAL)="",$G(PSOVDRUG)'="" S VAL=$P($G(^PSDRUG(PSOVDRUG,2)),"^",4)
  1. I $G(VAL)'="" D
  1. .S VAL=$$REPL(VAL)
  1. .S X="",X=GIVECODE,$P(X,SEPC,4)=VAL,$P(X,SEPC,6)="NDC",VAL=X D PUT(2)
  1. E S VAL=GIVECODE D PUT(2)
  1. S VAL=0 D PUT(3)
  1. ; (5-DEF="UNK" or API)
  1. S VAL=UNIT D PUT(5)
  1. ; (8~6-.02)
  1. S (VAL,WR)=""
  1. S WR=$$GET1^DIQ(52.2,PSOVDFD1_","_PSOVDFD0_",",.02,"","","PSOVERR") K PSOVERR I $G(WR)'="" S WR=$$REPL(WR),$P(VAL,SEPC,6)=WR D PUT(8)
  1. ; (10-.04)
  1. S VAL=$P(TP,U,4),VAL=$$REPL(VAL) D PUT(10)
  1. ; (14|1-.05)
  1. S VAL=$P(TP,U,5) I $G(VAL)="" G RXE3B
  1. S VAL=$$XCN200^VDEFEL(VAL,"PHARMACIST") D PUT(14)
  1. ; (18-8)
  1. RXE3B S VAL=$P(TP,U,19) I $G(VAL)'="" S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL>0 S VAL=$$REPL(VAL) D PUT(18)
  1. S VAL=$P(TP,U,10) I $G(VAL)'="" S VAL="D"_VAL,VAL=$$REPL(VAL) D PUT(22)
  1. D RXE31^PSOVDF3
  1. D PUT(31)
  1. ;
  1. I $G(MSG)="" G RXE3Q
  1. S MSG="RXE"_SEPF_MSG D OUT
  1. RXE3Q ; Q
  1. ;
  1. NTE3 ; PAR
  1. S MSG=""
  1. ; (3-.03)
  1. S WR=$P(TP,U,3) I $G(WR)="" G NTE3Q
  1. S VAL=PSOVDFD1 D PUT(1)
  1. S VAL=$$REPL(WR)
  1. D PUT(3),PREM^PSOVDF3,PUT(4)
  1. S MSG="NTE"_SEPF_MSG D OUT
  1. NTE3Q ; Q
  1. FT13 ; patch 261
  1. D FT1R^PSOVDF3
  1. G ORC3A
  1. ;
  1. Q