Changeset 636 for FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORELD1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORELD1.m (modified) (12 diffs)

FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORELD1.m

@@ -1 @@
-PSORELD1 ;BIR/PWC-HL7 V.2.4 EXTERNAL INTERFACE RELEASE DATE/TIME CONT. ;03/22/04
- ;;7.0;OUTPATIENT PHARMACY;**156**;DEC 1997
+PSORELD1 ;BIR/PWC-HL7 V.2.4 EXTERNAL INTERFACE RELEASE DATE/TIME CONT. ;5:23 AM  31 Jan 2008
+ ;;7.0;OUTPATIENT PHARMACY;**156**;DEC 1997;Build 4
+ ;Modified from FOIA VISTA,
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
  ;HLFNC supp. by DBIA 10106
  ;PSNAPIS supp. by DBIA 2531
@@ -25 +43 @@
  D PID(.PSI),PV1(.PSI),PV2(.PSI),ORC(.PSI),RXE(.PSI),RXD(.PSI)
  ; clean up data set by GETDATA
- K BINGO,RELDT,SITE,SITADD,SITPHN,PSOXN,PSOXN2,PSND1,PSND2,PSND3,PRODUCT,PSOPROD,VANAME,UNIT,PSDOSE,PODOSENM,POIPTR,NRFL,DISPDT,COPAY,ERR,PSONDC,NFDL,NFLD,PSZIP,PSOHZIP,TRADENM,X,Y,UU
- Q
+ K BINGO,RELDT,SITE,SITADD,SITPHN,PSOXN,PSOXN2,PSND1,PSND2,PSND3,PRODUCT,PSOPROD,VANAME
+ K UNIT,PSDOSE,PODOSENM,POIPTR,NRFL,DISPDT,COPAY,ERR,PSONDC,NFDL,NFLD,PSZIP,PSOHZIP,TRADENM,X,Y,UU
+ QUIT
+ ;  ========
 GETDATA ; this is the place to set all data needed for several segments
  I $G(FP)="F"&('$G(FPN)) D    ;original
@@ -32 +52 @@
  . S PVDR=$P(^PSRX(IRXN,0),"^",4),QTY=$P(^(0),"^",7),DASPLY=$P(^(0),"^",8),MW=$P(^(0),"^",11),EBY=$P(^(0),"^",16)
  I $G(FP)="F"&($G(FPN)) D    ;refill
- . S FDT=$P(^PSRX(IRXN,1,FPN,0),"^"),MW=$P(^(0),"^",2),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10),DISPDT=$P(^(0),"^",19),EXDT=$S($P(^(0),"^",15):$P(^(0),"^",15),1:$P(^PSRX(IRXN,2),"^",6))
+ . S FDT=$P(^PSRX(IRXN,1,FPN,0),"^"),MW=$P(^(0),"^",2),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10),DISPDT=$P(^(0),"^",19)
+ . S EXDT=$S($P(^(0),"^",15):$P(^(0),"^",15),1:$P(^PSRX(IRXN,2),"^",6))
  . S VPHARMID=$S($P(^PSRX(IRXN,1,FPN,0),"^",5)'="":$P(^(0),"^",5),1:$P(^PSRX(IRXN,2),"^",10))
- . S EBY=$S($P(^PSRX(IRXN,1,FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7)),PVDR=$P(^(0),"^",17),PSONDC=$S($P($G(^PSRX(IRXN,1,FPN,1)),"^",3):$P(^(1),"^",3),1:$P(^PSRX(IRXN,2),"^",7))
+ . S EBY=$S($P(^PSRX(IRXN,1,FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7)),PVDR=$P(^(0),"^",17)
+ . S PSONDC=$S($P($G(^PSRX(IRXN,1,FPN,1)),"^",3):$P(^(1),"^",3),1:$P(^PSRX(IRXN,2),"^",7))
  I $G(FP)="P" D  ;partial
- . S FDT=$P(^PSRX(IRXN,"P",FPN,0),"^"),MW=$P(^(0),"^",2),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10),DISPDT=$P(^(0),"^",13),PVDR=$P(^(0),"^",17),EXDT=$P(^PSRX(IRXN,2),"^",6)
- . S EBY=$S($P(^PSRX(IRXN,"P",FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7)),VPHARMID=$S($P(^(0),"^",5)'="":$P(^(0),"^",5),1:$P(^PSRX(IRXN,2),"^",10)),PVDR=$P(^PSRX(IRXN,"P",FPN,0),"^",17)
+ . S FDT=$P(^PSRX(IRXN,"P",FPN,0),"^"),MW=$P(^(0),"^",2),QTY=$P(^(0),"^",4),DASPLY=$P(^(0),"^",10),DISPDT=$P(^(0),"^",13)
+ . S PVDR=$P(^(0),"^",17),EXDT=$P(^PSRX(IRXN,2),"^",6)
+ . S EBY=$S($P(^PSRX(IRXN,"P",FPN,0),"^",5):$P(^(0),"^",5),1:$P(^(0),"^",7))
+ . S VPHARMID=$S($P(^(0),"^",5)'="":$P(^(0),"^",5),1:$P(^PSRX(IRXN,2),"^",10)),PVDR=$P(^PSRX(IRXN,"P",FPN,0),"^",17)
  . S PSONDC=$S($P(^PSRX(IRXN,"P",FPN,0),"^",12):$P(^(0),"^",12),1:$P(^PSRX(IRXN,2),"^",7))
  S EFDT=$P(^PSRX(IRXN,2),"^",2) S:$G(EFDT) EFDT=$$HLDATE^HLFNC(EFDT,"DT")
@@ -43 +67 @@
  S DEAID=$$GET1^DIQ(200,PVDR_",",53.2)
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=VPHARMID D ^DIC
- S VPHARM=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)):1,"""""") K DIC,X,Y
+ S VPHARM=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)),1:"""""") K DIC,X,Y
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=EBY D ^DIC
- S EBY1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)):1,"""""") K DIC,X,Y
+ S EBY1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)),1:"""""") K DIC,X,Y
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=PVDR D ^DIC
- S PVDR1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)):1,"""""") K DIC,X,Y
+ S PVDR1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)),1:"""""") K DIC,X,Y
  S PRIORDT=$P(^PSRX(IRXN,3),"^",4),PRIORDT=$$HLDATE^HLFNC(PRIORDT,"DT")
  S FDT=$$HLDATE^HLFNC(FDT,"DT")
@@ -55 +79 @@
  S FIN=$P(^PSRX(IRXN,"OR1"),"^",5)
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=FIN D ^DIC
- S FIN1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)):1,"""""") K DIC,X,Y
+ S FIN1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)),1:"""""") K DIC,X,Y
  S SITE=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
  S PSZIP=$P(SITE,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
@@ -61 +85 @@
  S CSINER=$P(^PSRX(IRXN,3),"^",3)
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=CSINER D ^DIC
- S CSINER1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)):1,"""""") K DIC,X,Y
+ S CSINER1=$S(+Y:$$HLNAME^HLFNC($P(Y,"^",2)),1:"""""") K DIC,X,Y
  D 6^VADPT
  I MW="W" S MP=$S($P($G(^PSRX(IRXN,"MP")),"^"):$P(^("MP"),"^"),1:"""""")
@@ -87 +111 @@
  S NFLD=0,UU="" F  S UU=$O(^PSRX(IRXN,1,UU)) Q:UU=""  S:$D(^PSRX(IRXN,1,UU,0)) NFLD=NFLD+1
  S NRFL=$P(^PSRX(IRXN,0),"^",9),RFRM=(NRFL-NFLD)
- Q
+ QUIT
+ ;  =========
 PID(PSI) ;patient ID segment
- Q:'$D(DFN)!$D(PAS)
+ QUIT:'$D(DFN)!$D(PAS)
+ ;
  S HLFS=HL1("FS"),HLECH=HL1("ECH"),HLQ=HL1("Q"),HLVER=HL1("VER")
  K PSPID,PSPID1
@@ -127 +153 @@
  S PAS=1
  K PSPID,PSPID1,PRSEPID,PRSEZTA,SPOT,TMPADD,ADDSEQ
- Q
+ QUIT
+ ;  =========
 PV1(PSI) ;patient visit segment
  N PV1  ;hardcoded to letter O for Outpatient (Patient class)
@@ -133 +160 @@
  S ^TMP("PSO",$J,PSI)=PV1
  S PSI=PSI+1
- Q
+ QUIT
+ ;  =========
 PV2(PSI) ;patient visit segment (additional information)
  ;PATIENT STATUS AND COPAY
@@ -140 +168 @@
  S ^TMP("PSO",$J,PSI)="PV2|"_PV2
  S PSI=PSI+1
- Q
+ QUIT
+ ;  =========
 ORC(PSI) ;common order segment
- Q:'$D(DFN)
+ QUIT:'$D(DFN)
+ ;
  N ORC S ORC=""
  S $P(ORC,"|",1)="OE"
@@ -154 +184 @@
  S $P(ORC,"|",17)=CLN_CS_CLN1_CS_"99PSC"
  S $P(ORC,"|",19)=$S(CSINER'="":CSINER_CS_CSINER1,1:"")
- S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6)_
+ ;  3080129 - RCR
+ ;  Segment 21 is incomplete.  Truncated.
+ ; S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6)_
+ S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6)
  S PSZIP=$P(SITE,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
  S $P(ORC,"|",22)=$P(SITE,"^",2)_CS_CS_$P(SITE,"^",7)_CS_$S($D(^DIC(5,+$P(SITE,"^",8),0)):$P(^(0),"^",2),1:"UKN")_CS_PSOHZIP
  S $P(ORC,"|",23)="("_$P(SITE,"^",3)_")"_$P(SITE,"^",4)
  S ^TMP("PSO",$J,PSI)="ORC|"_ORC,PSI=PSI+1
- Q
+ QUIT
+ ;  ===========
 RXE(PSI) ;Pharmacy/treatment Encoded Order segment
- Q:'$D(DFN)
- N RXE S RXE=""
+ QUIT:'$D(DFN)
+ ;
+ N RXE,PSDRG10
+ S RXE=""
  S $P(RXE,"|",1)=""""""
- S $P(RXE,"|",2)=$S($P($G(^PSDRUG(IDGN,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_$G(PSND2)_CS_"99PSNDF"_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
+ S PSDRG10=$P($G(^PSDRUG(IDGN,"ND")),"^",10)
+ ;
+ ;  29JAN2008 - RCR ; The problem is tha/home/rcr/PSORELD1.mt the last $PIECE is incomplete.  This needs to be validated
+ ; S $P(RXE,"|",2)=$S($P($G(^PSDRUG(IDGN,"ND")),"^",10)'="":$P(^("ND"),"^",10),($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_$G(PSND2)_CS_"99PSNDF"_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^"_CS_"99PSD"
+ S $P(RXE,"|",2)=$S(PSDRG10'="":PSDRG10,($G(PSND1)&$G(PSND3)):$P($G(PSOXN2),"^",2),1:"""""")_CS_$G(PSND2)_CS_"99PSNDF"_CS_PSND1_"."_PSND3_"."_$G(IDGN)_CS_$P($G(^PSDRUG(IDGN,0)),"^")_CS_"99PSD"
  S $P(RXE,"|",3)=""
  I $G(PSOXN)="" S PSOXN=""""""
  S $P(RXE,"|",5)=PSOXN_CS_$S($G(UNIT)'="":$G(UNIT),1:"""""")_CS_"99PSU"
- S POIPTR=$P($G(^PSRX(IRXN,"OR1")),"^") I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$G(^PS(50.606,PODOSE,0))
+ S POIPTR=$P($G(^PSRX(IRXN,"OR1")),"^")
+ I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$G(^PS(50.606,PODOSE,0))
  I '$G(POIPTR) S PODOSE=$P($G(^PS(50.7,$P($G(^PSDRUG(IDGN,2)),"^"),0)),"^",2),PODOSENM=$G(^PS(50.606,PODOSE,0))
  S TRADENM=$G(^PSRX(IRXN,"TN"))
  S $P(RXE,"|",6)=PODOSE_CS_PODOSENM_CS_"99PSF"
  S $P(RXE,"|",8)=MP
- S $P(RXE,"|",9)=TRADENM_
+ ;
+ ; 3080129 - RCR
+ ; Segment 9 is incomplete, truncated.
+ ; S $P(RXE,"|",9)=TRADENM_
+ S $P(RXE,"|",9)=TRADENM
  S $P(RXE,"|",15)=$P(^PSRX(IRXN,0),"^")
  S ^TMP("PSO",$J,PSI)="RXE|"_RXE,PSI=PSI+1
- Q
+ QUIT
+ ;  =========
 RXD(PSI) ;pharmacy dispense segment
- Q:'$D(DFN)
+ QUIT:'$D(DFN)
+ ;
  N RXD S RXD=""
  S $P(RXD,"|",1)=$S($G(NFLD):NFLD,1:0)
@@ -185 +232 @@
  S $P(RXD,"|",7)=$P(^PSRX(IRXN,0),"^")
  S $P(RXD,"|",9)=RELDT_RS_BINGO_RS_PSONDC
- Q
+ QUIT
+ ;  ========