- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLSN1.m
r613 r623 1 PSOHLSN1 ;BIR/RTR - Send order info to OERR from file 52 ;10/10/94 2 ;;7.0;OUTPATIENT PHARMACY;**1,10,24,27,55,46,71,101,99,121,139,157,181,143,235,239,292,225**;DEC 1997;Build 29 3 ;Ref #50.606-DBIA 2174 4 ;#50.607-2221 5 ;#50.7-2223 6 ;#51.2-2226 7 ;#50-221 8 ;PSNDF-2195 9 ;EN^PSSUTIL1-3179 10 ; 11 EN(PSRXIEN,STAT,PSSTAT,COMM,PSNOO) ; 12 N COUNT,DFN,J,LIMIT,NAME,NULLFLDS,PSDIEN,PSFLAG,PSND1,PSND2,PSND3,PRODUCT,UNIT,POIPTR,PSOHINST,PODOSE,PODOSENM,PSROUTE,RTNAME,SEGMENT,CCC,BBB,CSCOUNT,PPTR,MSG,PSOHSTRT,PSOHSTOP,PSOHISSD,PSORTLP,ZRXFLAG,RXE2FLAG,RXE2ONLY,PSODFN,EDUZ 13 N PSOCDDUZ,DA,FSIG,BSIG,PSHRX,PSHORX,PSNOOTX,ZPRE,PSOZSTAT,CCCX,PSOCPS,PSOICD 14 K FIELD 15 I $G(STAT)="" Q 16 I STAT="CR"!(STAT="DR")!(STAT="HR")!(STAT="OC")!(STAT="OD")!(STAT="OH")!(STAT="Z@")!(STAT="RP") S PSOZSTAT=STAT D DELP^PSOHLSN S STAT=PSOZSTAT G SKIP 17 I STAT="SC" I $G(PSSTAT)="ZE"!($G(PSSTAT)="HD")!($G(PSSTAT)="DC") S PSOZSTAT=STAT D DELP^PSOHLSN S STAT=PSOZSTAT 18 SKIP ; 19 I $G(STAT)="SC",$G(PSSTAT)="ZE",$P($G(^PSRX(+$G(PSRXIEN),0)),"^",19)=2 Q 20 I $G(STAT)="RP" S STAT="OD",PSSTAT="RP" 21 S COUNT=0,NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)=""""" 22 I '$D(^PSRX(PSRXIEN,0)) Q 23 I ($G(STAT)="SC"&($G(PSSTAT)="ZE"))!($G(STAT)="OC")!($G(STAT)="OD") I $D(^PS(52.41,"AQ",PSRXIEN)) D EN^PSOHDR("PRES",PSRXIEN) Q 24 I STAT'="SN",STAT'="ZC",'$P($G(^PSRX(PSRXIEN,"OR1")),"^",2) Q 25 I $G(STAT)="SC",$G(PSSTAT)="ZE" S $P(^PSRX(PSRXIEN,0),"^",19)=2 26 D INIT 27 S COUNT=1,(ZRXFLAG,RXE2FLAG,RXE2ONLY)=0 D PID,PV1,ORC 28 I $G(STAT)="Z@" G NCM 29 I $G(STAT)="OK"!($G(STAT)="SN")!($G(STAT)="ZC")!($G(STAT)="XX")!($G(STAT)="SC")!($G(STAT)="RO") D RXO,RXE,RXR,ZRX,DG1,ZSC,ZCL G NCM 30 I $G(STAT)="SC",$G(PSSTAT)="CM" D RXO,RXE,RXR,ZRX,DG1,ZSC,ZCL 31 I '$G(RXE2FLAG) S RXE2ONLY=1 D RXE,SEGPARX^PSOHLSN 32 I '$G(ZRXFLAG) D ZRX 33 NCM D SEND 34 K PSRXIEN Q 35 INIT K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^") I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC 36 S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||"_$S($G(PSOMSORR):"ORR",1:"ORM") 37 Q 38 PID S LIMIT=5 X NULLFLDS 39 S DFN=+$P(^PSRX(PSRXIEN,0),"^",2) D DEM^VADPT S NAME=$G(VADM(1)) K VADM 40 S FIELD(0)="PID" 41 S FIELD(3)=DFN 42 S FIELD(5)=NAME 43 D SEG Q 44 DG1 D DG1^PSOHLSN2 45 Q 46 PV1 ; 47 S LIMIT=19 X NULLFLDS 48 S FIELD(0)="PV1" 49 S FIELD(2)="O" 50 S:$P(^PSRX(PSRXIEN,0),"^",5) FIELD(3)=$P(^(0),"^",5) 51 D SEG Q 52 ORC ; 53 D ORC^PSOHLSN3 54 Q 55 ; 56 RXO ; 57 S LIMIT=1 X NULLFLDS 58 S FIELD(0)="RXO" 59 S PPTR=+$P($G(^PSRX(PSRXIEN,"OR1")),"^") 60 S FIELD(1)=$S('PPTR:"^^^^^",1:"^^^"_PPTR_"^"_$P($G(^PS(50.7,PPTR,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")_"^99PSP") 61 D SEG Q 62 ; 63 RXE ; 64 S RXE2FLAG=1 65 S LIMIT=$S('$G(RXE2ONLY):26,1:2) X NULLFLDS 66 S FIELD(0)="RXE" 67 S (PSOHSTRT,PSOHSTOP)="" S X=$P($G(^PSRX(PSRXIEN,2)),"^",2) I X S PSOHSTRT=$$FMTHL7^XLFDT(X) 68 I '$G(DT) S DT=$$DT^XLFDT 69 S X=$S($P($G(^PSRX(PSRXIEN,3)),"^",5):$P($G(^(3)),"^",5),$G(STAT)="OD"!($G(STAT)="OC"):$G(DT),$P($G(^(2)),"^",6):$P($G(^(2)),"^",6),1:$G(DT)) I X S PSOHSTOP=$$FMTHL7^XLFDT(X) 70 K X N PSOMZT,MMZZ,MMZZT S MMZZT=1 F MMZZ=0:0 S MMZZ=$O(^PSRX(PSRXIEN,6,MMZZ)) Q:'MMZZ D:$D(^(MMZZ,0)) 71 .S FIELD(1,MMZZT)=$S($P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",2):$$ESC^ORHLESC($P($G(^(0)),"^"))_"\T\"_$P($G(^PS(50.607,+$P($G(^(0)),"^",3),0)),"^")_"\T\"_$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",2)_"\T\"_$P($G(^(0)),"^",4),1:"") 72 .S FIELD(1,MMZZT)=FIELD(1,MMZZT)_"^"_$$ESC^ORHLESC($P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",8)) 73 .I $P($G(FIELD(1,MMZZT)),"^")'="" F PSOMZT=1,3 I $E($P(FIELD(1,MMZZT),"\T\",PSOMZT),1)="." S $P(FIELD(1,MMZZT),"\T\",PSOMZT)="0"_$P(FIELD(1,MMZZT),"\T\",PSOMZT) 74 .S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"^"_$$DUR(PSRXIEN,MMZZ)_"^^^^^"_$S($P($G(FIELD(1,MMZZT)),"^")'="":$P($G(FIELD(1,MMZZT)),"\T\")_$P($G(FIELD(1,MMZZT)),"\T\",2),1:$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^")) 75 .S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"^"_$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",6) 76 .I $O(^PSRX(PSRXIEN,6,MMZZ)) S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"~" 77 .S MMZZT=MMZZT+1 78 S $P(FIELD(1,1),"^",4)=$G(PSOHSTRT),$P(FIELD(1,1),"^",5)=$G(PSOHSTOP) 79 S PSFLAG=0,PSDIEN=+$P(^PSRX(PSRXIEN,0),"^",6),PSND1=$P($G(^PSDRUG(PSDIEN,"ND")),"^"),PSND2=$P($G(^("ND")),"^",2),PSND3=$P($G(^("ND")),"^",3) I PSND1,PSND3 S PSFLAG=1 80 S FIELD(2)=$S(PSFLAG:PSND1_"."_PSND3_"^"_$$ESC^ORHLESC(PSND2)_"^"_"99NDF",1:"^^")_"^"_PSDIEN_"^"_$$ESC^ORHLESC($P($G(^PSDRUG(PSDIEN,0)),"^"))_"^"_"99PSD" 81 Q:$G(RXE2ONLY) 82 I PSFLAG D 83 .I $T(^PSNAPIS)]"" S PSOXN=$$DFSU^PSNAPIS(PSND1,PSND3) S FIELD(5)="^^^"_$P($G(PSOXN),"^",5)_"^"_$$ESC^ORHLESC($P($G(PSOXN),"^",6))_"^"_"99PSU" K PSOXN Q 84 .S PRODUCT=$G(^PSNDF(PSND1,5,PSND3,0)) S UNIT=$P($G(^PSNDF(PSND1,2,+$P(PRODUCT,"^",2),3,+$P(PRODUCT,"^",3),4,+$P(PRODUCT,"^",4),0)),"^") 85 .S FIELD(5)="^^^"_UNIT_"^"_$$ESC^ORHLESC($P($G(^PS(50.607,+UNIT,0)),"^"))_"^"_"99PSU" 86 S POIPTR=$P($G(^PSRX(PSRXIEN,"OR1")),"^") I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$P($G(^PS(50.606,+PODOSE,0)),"^") 87 I POIPTR S FIELD(6)="^^^"_$G(PODOSE)_"^"_$$ESC^ORHLESC($G(PODOSENM))_"^"_"99PSF" 88 S FIELD(10)=$P(^PSRX(PSRXIEN,0),"^",7) 89 S FIELD(12)=$P(^PSRX(PSRXIEN,0),"^",9) 90 S FIELD(14)=$P(^PSRX(PSRXIEN,0),"^",4) 91 S FIELD(15)=$P(^PSRX(PSRXIEN,0),"^") 92 S FIELD(22)=$P(^PSRX(PSRXIEN,0),"^",8) 93 K MMZZ S MMZZ=$$EN^PSSUTIL1(PSDIEN) S FIELD(25)=$S($E($P(MMZZ,"|"),1)=".":"0",1:"")_$P(MMZZ,"|"),FIELD(26)=$P(MMZZ,"|",2) 94 N PLIM,PVAR,PVAR1,SUBCOUNT D SEGPARX^PSOHLSN 95 ; 96 I $O(^PSRX(PSRXIEN,"PRC",0)) D 97 .S COUNT=COUNT+1,CCC=$O(^PSRX(PSRXIEN,"PRC",0)) 98 .S MSG(COUNT)="NTE|6||"_$$ESC^ORHLESC($G(^PSRX(PSRXIEN,"PRC",CCC,0))) 99 .S CSCOUNT=1 F CCC=CCC:0 S CCC=$O(^PSRX(PSRXIEN,"PRC",CCC)) Q:'CCC S MSG(COUNT,CSCOUNT)=$$ESC^ORHLESC($G(^PSRX(PSRXIEN,"PRC",CCC,0))),CSCOUNT=CSCOUNT+1 100 I $O(^PSRX(PSRXIEN,"INS1",0)) D 101 .S COUNT=COUNT+1,CCC=$O(^PSRX(PSRXIEN,"INS1",0)) 102 .S MSG(COUNT)="NTE|7|L|"_$$ESC^ORHLESC($G(^PSRX(PSRXIEN,"INS1",CCC,0))) 103 .S CCCX=1 F S CCC=$O(^PSRX(PSRXIEN,"INS1",CCC)) Q:'CCC I $D(^PSRX(PSRXIEN,"INS1",CCC,0)) S MSG(COUNT,CCCX)=$$ESC^ORHLESC($G(^(0))) S CCCX=CCCX+1 104 S COUNT=COUNT+1 105 I $P($G(^PSRX(PSRXIEN,"SIG")),"^",2) D Q 106 .D FSIG^PSOUTLA("R",PSRXIEN,238) S MSG(COUNT)="NTE|21||"_$S($G(FSIG(1))'="":$$ESC^ORHLESC($G(FSIG(1))),1:"No SIG available") I $O(FSIG(1)) F CCC=1:0 S CCC=$O(FSIG(CCC)) Q:'CCC S MSG(COUNT,(CCC-1))=$$ESC^ORHLESC($G(FSIG(CCC))) 107 I '$P($G(^PSRX(PSRXIEN,"SIG")),"^",2) D Q 108 .D EN3^PSOUTLA1(PSRXIEN,238) S MSG(COUNT)="NTE|21||"_$S($G(BSIG(1))'="":$$ESC^ORHLESC($G(BSIG(1))),1:"No SIG available") I $O(BSIG(1)) F CCC=1:0 S CCC=$O(BSIG(CCC)) Q:'CCC S MSG(COUNT,(CCC-1))=$$ESC^ORHLESC($G(BSIG(CCC))) 109 Q 110 ; 111 RXR ; 112 F PSORTLP=0:0 S PSORTLP=$O(^PSRX(PSRXIEN,6,PSORTLP)) Q:'PSORTLP D 113 .S LIMIT=1 X NULLFLDS 114 .S FIELD(0)="RXR" 115 .S PSROUTE=$P($G(^PSRX(PSRXIEN,6,PSORTLP,0)),"^",7) I PSROUTE,$D(^PS(51.2,PSROUTE,0)) S RTNAME=$P(^PS(51.2,PSROUTE,0),"^") 116 .S FIELD(1)="^^^"_$G(PSROUTE)_"^"_$G(RTNAME)_"^"_"99PSR" 117 .D SEG 118 Q 119 ; 120 ZCL D ZCL^PSOHLSN2 121 Q 122 ZSC D ZSC^PSOHLSN2 123 Q 124 ; 125 ZRX ; 126 S ZRXFLAG=1 127 S LIMIT=6 X NULLFLDS 128 S FIELD(0)="ZRX" 129 S ZPRE=$P($G(^PSRX(PSRXIEN,"OR1")),"^",3) I ZPRE S FIELD(1)=$P($G(^PSRX(ZPRE,"OR1")),"^",2) 130 I '$G(FIELD(1)),$G(PSORDEDT) S FIELD(1)=$P($G(^PS(52.41,$G(PSORDEDT),0)),"^") 131 S FIELD(2)=$G(PSNOO) 132 I $G(STAT)="SN"!($G(STAT)="RO") S FIELD(3)=$S($G(STAT)="RO"!($G(PSOEDIT)):"E",$G(PSOOPT)=3:"R",1:"N") 133 S FIELD(4)=$P(^PSRX(PSRXIEN,0),"^",11) 134 S PSOCDDUZ=$S($G(PSOROPCH)="PATCH":$P($G(^PSRX(PSRXIEN,"OR1")),"^",5),$G(PSOHUIOR)&($P($G(^PSRX(PSRXIEN,"EXT")),"^")'=""):+$G(PSOCANRC),1:$G(DUZ)) 135 I $G(PSOCDDUZ) S FIELD(5)=PSOCDDUZ_"^"_$P($G(^VA(200,PSOCDDUZ,0)),"^")_"^"_"99NP" 136 I $G(STAT)="ZD",$G(PSODISPP) S FIELD(6)="P" 137 D SEG Q 138 SEG S SEGMENT="" F J=0:1:LIMIT S SEGMENT=$S(SEGMENT="":FIELD(J),1:SEGMENT_"|"_FIELD(J)) 139 S COUNT=COUNT+1,MSG(COUNT)=SEGMENT 140 Q 141 SEND D:$G(PSRXIEN)&($T(EN^PSOHDR)]"")&($G(PSOSSMES)'="CPRSUP") K FIELD D MSG^XQOR("PS EVSEND OR",.MSG) Q 142 .I $G(STAT)="ZC"!($G(STAT)="UC")!($G(STAT)="UD")!($G(STAT)="UH")!($G(STAT)="UR")!($G(STAT)="DE")!($G(STAT)="ZD")!($G(STAT)="SN")!($G(STAT)="Z@") Q 143 .I $G(STAT)="SC",$G(PSSTAT)="ZZ" Q 144 .D EN^PSOHDR("PRES",PSRXIEN) 145 ; 146 NOO ; 147 I $G(PSNOO)="" S PSNOOTX="" Q 148 S PSNOOTX=$S(PSNOO="W":"Written",PSNOO="V":"Verbal",PSNOO="P":"Telephoned",PSNOO="S":"Service Correction",PSNOO="X":"Rejected",PSNOO="D":"Duplicate",PSNOO="I":"Policy",PSNOO="E":"Physician Entered",PSNOO="A":"Auto DC",1:"") Q 149 Q 150 ; 151 DUR(PSODX1,PSODX2) ; 152 N PSODX,PSODX4,PSODX5,PSODX6,PSODX7 S PSODX=$P($G(^PSRX(PSODX1,6,PSODX2,0)),"^",5) 153 I 'PSODX Q PSODX 154 S PSODX4=$L(PSODX),PSODX5=$E(PSODX,PSODX4) 155 S PSODX=$S(PSODX5?1A:PSODX,1:PSODX_"D") 156 S PSODX6=$L(PSODX) 157 S PSODX7=$E(PSODX,PSODX6)_$E(PSODX,1,(PSODX6-1)) 158 Q PSODX7 159 Q 1 PSOHLSN1 ;BIR/RTR - Send order info to OERR from file 52 ;10/10/94 2 ;;7.0;OUTPATIENT PHARMACY;**1,10,24,27,55,46,71,101,99,121,139,157,181,143,235,239**;DEC 1997 3 ;Ref #50.606-DBIA 2174 4 ;#50.607-2221 5 ;#50.7-2223 6 ;#51.2-2226 7 ;#50-221 8 ;PSNDF-2195 9 ;EN^PSSUTIL1-3179 10 ; 11 EN(PSRXIEN,STAT,PSSTAT,COMM,PSNOO) ; 12 N COUNT,DFN,J,LIMIT,NAME,NULLFLDS,PSDIEN,PSFLAG,PSND1,PSND2,PSND3,PRODUCT,UNIT,POIPTR,PSOHINST,PODOSE,PODOSENM,PSROUTE,RTNAME,SEGMENT,CCC,BBB,CSCOUNT,PPTR,MSG,PSOHSTRT,PSOHSTOP,PSOHISSD,PSORTLP,ZRXFLAG,RXE2FLAG,RXE2ONLY,PSODFN,EDUZ 13 N PSOCDDUZ,DA,FSIG,BSIG,PSHRX,PSHORX,PSNOOTX,ZPRE,PSOZSTAT,CCCX,PSOCPS,PSOICD 14 K FIELD 15 I $G(STAT)="" Q 16 I STAT="CR"!(STAT="DR")!(STAT="HR")!(STAT="OC")!(STAT="OD")!(STAT="OH")!(STAT="Z@")!(STAT="RP") S PSOZSTAT=STAT D DELP^PSOHLSN S STAT=PSOZSTAT G SKIP 17 I STAT="SC" I $G(PSSTAT)="ZE"!($G(PSSTAT)="HD")!($G(PSSTAT)="DC") S PSOZSTAT=STAT D DELP^PSOHLSN S STAT=PSOZSTAT 18 SKIP ; 19 I $G(STAT)="SC",$G(PSSTAT)="ZE",$P($G(^PSRX(+$G(PSRXIEN),0)),"^",19)=2 Q 20 I $G(STAT)="RP" S STAT="OD",PSSTAT="RP" 21 S COUNT=0,NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)=""""" 22 I '$D(^PSRX(PSRXIEN,0)) Q 23 I STAT'="SN",STAT'="ZC",'$P($G(^PSRX(PSRXIEN,"OR1")),"^",2) Q 24 I $G(STAT)="SC",$G(PSSTAT)="ZE" S $P(^PSRX(PSRXIEN,0),"^",19)=2 25 D INIT 26 S COUNT=1,(ZRXFLAG,RXE2FLAG,RXE2ONLY)=0 D PID,PV1,ORC 27 I $G(STAT)="Z@" G NCM 28 I $G(STAT)="OK"!($G(STAT)="SN")!($G(STAT)="ZC")!($G(STAT)="XX")!($G(STAT)="SC")!($G(STAT)="RO") D RXO,RXE,RXR,ZRX,DG1,ZSC,ZCL G NCM 29 I $G(STAT)="SC",$G(PSSTAT)="CM" D RXO,RXE,RXR,ZRX,DG1,ZSC,ZCL 30 I '$G(RXE2FLAG) S RXE2ONLY=1 D RXE,SEGPARX^PSOHLSN 31 I '$G(ZRXFLAG) D ZRX 32 NCM D SEND 33 K PSRXIEN Q 34 INIT K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^") I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC 35 S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||"_$S($G(PSOMSORR):"ORR",1:"ORM") 36 Q 37 PID S LIMIT=5 X NULLFLDS 38 S DFN=+$P(^PSRX(PSRXIEN,0),"^",2) D DEM^VADPT S NAME=$G(VADM(1)) K VADM 39 S FIELD(0)="PID" 40 S FIELD(3)=DFN 41 S FIELD(5)=NAME 42 D SEG Q 43 DG1 D DG1^PSOHLSN2 44 Q 45 PV1 ; 46 S LIMIT=19 X NULLFLDS 47 S FIELD(0)="PV1" 48 S FIELD(2)="O" 49 S:$P(^PSRX(PSRXIEN,0),"^",5) FIELD(3)=$P(^(0),"^",5) 50 D SEG Q 51 ORC ; 52 S LIMIT=15 X NULLFLDS 53 S FIELD(0)="ORC" 54 S FIELD(1)=$G(STAT) 55 I $G(STAT)'="SN",$G(STAT)'="ZC" S FIELD(2)=$P($G(^PSRX(PSRXIEN,"OR1")),"^",2) 56 S:FIELD(2)'="" FIELD(2)=FIELD(2)_$S($G(PLACERXX):";"_PLACERXX,1:"")_"^OR" 57 S FIELD(3)=PSRXIEN_"^PS" 58 S FIELD(5)=$G(PSSTAT) 59 I $G(STAT)="RO",$G(PSOROPCH)'="PATCH" S FIELD(5)="CM" 60 I $G(FIELD(5))="" I $G(STAT)="OR"!($G(STAT)="OE") S FIELD(5)="CM" 61 S X=$P($G(^PSRX(PSRXIEN,2)),"^") I X S FIELD(9)=$$FMTHL7^XLFDT(X) 62 S EDUZ=$P($G(^PSRX(PSRXIEN,0)),"^",16) I EDUZ S FIELD(10)=EDUZ_"^"_$P($G(^VA(200,EDUZ,0)),"^") 63 I $G(PSOCANRC),$G(PSOCANRN)'="" I $G(STAT)="OD"!($G(STAT)="OC") S FIELD(12)=$G(PSOCANRC)_"^"_$G(PSOCANRN) 64 I '$G(FIELD(12)) S FIELD(12)=$P($G(^PSRX(PSRXIEN,0)),"^",4)_"^"_$P($G(^VA(200,+$P($G(^PSRX(PSRXIEN,0)),"^",4),0)),"^") 65 S PSOHISSD="",X=$P($G(^PSRX(PSRXIEN,0)),"^",13) I X S PSOHISSD=$$FMTHL7^XLFDT(X) 66 S FIELD(15)=$G(PSOHISSD) K X 67 D SEG 68 I $G(COMM)'=""!($G(PSNOO)'="") D 69 .I $G(PSNOO)'="" D NOO 70 .I $L($G(COMM))+($L(MSG(COUNT)))+($L($G(PSNOOTX)))+($S($G(PSNOO)'="":11,1:5))<245 S MSG(COUNT)=MSG(COUNT)_"|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$G(COMM)_"^" Q 71 .S MSG(COUNT,1)="|"_$G(PSNOO)_"^"_$G(PSNOOTX)_"^"_$S($G(PSNOO)'="":"99ORN",1:"")_"^^"_$G(COMM)_"^" 72 Q 73 ; 74 RXO ; 75 S LIMIT=1 X NULLFLDS 76 S FIELD(0)="RXO" 77 S PPTR=+$P($G(^PSRX(PSRXIEN,"OR1")),"^") 78 S FIELD(1)=$S('PPTR:"^^^^^",1:"^^^"_PPTR_"^"_$P($G(^PS(50.7,PPTR,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")_"^99PSP") 79 D SEG Q 80 ; 81 RXE ; 82 S RXE2FLAG=1 83 S LIMIT=$S('$G(RXE2ONLY):26,1:2) X NULLFLDS 84 S FIELD(0)="RXE" 85 S (PSOHSTRT,PSOHSTOP)="" S X=$P($G(^PSRX(PSRXIEN,2)),"^",2) I X S PSOHSTRT=$$FMTHL7^XLFDT(X) 86 I '$G(DT) S DT=$$DT^XLFDT 87 S X=$S($P($G(^PSRX(PSRXIEN,3)),"^",5):$P($G(^(3)),"^",5),$G(STAT)="OD"!($G(STAT)="OC"):$G(DT),$P($G(^(2)),"^",6):$P($G(^(2)),"^",6),1:$G(DT)) I X S PSOHSTOP=$$FMTHL7^XLFDT(X) 88 K X N PSOMZT,MMZZ,MMZZT S MMZZT=1 F MMZZ=0:0 S MMZZ=$O(^PSRX(PSRXIEN,6,MMZZ)) Q:'MMZZ D:$D(^(MMZZ,0)) 89 .S FIELD(1,MMZZT)=$S($P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",2):$P($G(^(0)),"^")_"&"_$P($G(^PS(50.607,+$P($G(^(0)),"^",3),0)),"^")_"&"_$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",2)_"&"_$P($G(^(0)),"^",4),1:"")_"^"_$P($G(^(0)),"^",8) 90 .I $P($G(FIELD(1,MMZZT)),"^")'="" F PSOMZT=1,3 I $E($P(FIELD(1,MMZZT),"&",PSOMZT),1)="." S $P(FIELD(1,MMZZT),"&",PSOMZT)="0"_$P(FIELD(1,MMZZT),"&",PSOMZT) 91 .S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"^"_$$DUR(PSRXIEN,MMZZ)_"^^^^^"_$S($P($G(FIELD(1,MMZZT)),"^")'="":$P($G(FIELD(1,MMZZT)),"&")_$P($G(FIELD(1,MMZZT)),"&",2),1:$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^")) 92 .S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"^"_$P($G(^PSRX(PSRXIEN,6,MMZZ,0)),"^",6) 93 .I $O(^PSRX(PSRXIEN,6,MMZZ)) S FIELD(1,MMZZT)=$G(FIELD(1,MMZZT))_"~" 94 .S MMZZT=MMZZT+1 95 S $P(FIELD(1,1),"^",4)=$G(PSOHSTRT),$P(FIELD(1,1),"^",5)=$G(PSOHSTOP) 96 S PSFLAG=0,PSDIEN=+$P(^PSRX(PSRXIEN,0),"^",6),PSND1=$P($G(^PSDRUG(PSDIEN,"ND")),"^"),PSND2=$P($G(^("ND")),"^",2),PSND3=$P($G(^("ND")),"^",3) I PSND1,PSND3 S PSFLAG=1 97 S FIELD(2)=$S(PSFLAG:PSND1_"."_PSND3_"^"_PSND2_"^"_"99NDF",1:"^^")_"^"_PSDIEN_"^"_$P($G(^PSDRUG(PSDIEN,0)),"^")_"^"_"99PSD" 98 Q:$G(RXE2ONLY) 99 I PSFLAG D 100 .I $T(^PSNAPIS)]"" S PSOXN=$$DFSU^PSNAPIS(PSND1,PSND3) S FIELD(5)="^^^"_$P($G(PSOXN),"^",5)_"^"_$P($G(PSOXN),"^",6)_"^"_"99PSU" K PSOXN Q 101 .S PRODUCT=$G(^PSNDF(PSND1,5,PSND3,0)) S UNIT=$P($G(^PSNDF(PSND1,2,+$P(PRODUCT,"^",2),3,+$P(PRODUCT,"^",3),4,+$P(PRODUCT,"^",4),0)),"^") 102 .S FIELD(5)="^^^"_UNIT_"^"_$P($G(^PS(50.607,+UNIT,0)),"^")_"^"_"99PSU" 103 S POIPTR=$P($G(^PSRX(PSRXIEN,"OR1")),"^") I POIPTR S PODOSE=$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$P($G(^PS(50.606,+PODOSE,0)),"^") 104 I POIPTR S FIELD(6)="^^^"_$G(PODOSE)_"^"_$G(PODOSENM)_"^"_"99PSF" 105 S FIELD(10)=$P(^PSRX(PSRXIEN,0),"^",7) 106 S FIELD(12)=$P(^PSRX(PSRXIEN,0),"^",9) 107 S FIELD(14)=$P(^PSRX(PSRXIEN,0),"^",4) 108 S FIELD(15)=$P(^PSRX(PSRXIEN,0),"^") 109 S FIELD(22)=$P(^PSRX(PSRXIEN,0),"^",8) 110 K MMZZ S MMZZ=$$EN^PSSUTIL1(PSDIEN) S FIELD(25)=$S($E($P(MMZZ,"|"),1)=".":"0",1:"")_$P(MMZZ,"|"),FIELD(26)=$P(MMZZ,"|",2) 111 N PLIM,PVAR,PVAR1,SUBCOUNT D SEGPARX^PSOHLSN 112 ; 113 I $O(^PSRX(PSRXIEN,"PRC",0)) D 114 .S COUNT=COUNT+1,CCC=$O(^PSRX(PSRXIEN,"PRC",0)) 115 .S MSG(COUNT)="NTE|6||"_$G(^PSRX(PSRXIEN,"PRC",CCC,0)) 116 .S CSCOUNT=1 F CCC=CCC:0 S CCC=$O(^PSRX(PSRXIEN,"PRC",CCC)) Q:'CCC S MSG(COUNT,CSCOUNT)=$G(^PSRX(PSRXIEN,"PRC",CCC,0)),CSCOUNT=CSCOUNT+1 117 I $O(^PSRX(PSRXIEN,"INS1",0)) D 118 .S COUNT=COUNT+1,CCC=$O(^PSRX(PSRXIEN,"INS1",0)) 119 .S MSG(COUNT)="NTE|7|L|"_$G(^PSRX(PSRXIEN,"INS1",CCC,0)) 120 .S CCCX=1 F CCC=CCC:0 S CCC=$O(^PSRX(PSRXIEN,"INS1",CCC,0)) Q:'CCC I $D(^(0)) S MSG(COUNT,CCCX)=$G(^(0)) S CCCX=CCCX+1 121 S COUNT=COUNT+1 122 I $P($G(^PSRX(PSRXIEN,"SIG")),"^",2) D Q 123 .D FSIG^PSOUTLA("R",PSRXIEN,238) S MSG(COUNT)="NTE|21||"_$S($G(FSIG(1))'="":$G(FSIG(1)),1:"No SIG available") I $O(FSIG(1)) F CCC=1:0 S CCC=$O(FSIG(CCC)) Q:'CCC S MSG(COUNT,(CCC-1))=$G(FSIG(CCC)) 124 I '$P($G(^PSRX(PSRXIEN,"SIG")),"^",2) D Q 125 .D EN3^PSOUTLA1(PSRXIEN,238) S MSG(COUNT)="NTE|21||"_$S($G(BSIG(1))'="":$G(BSIG(1)),1:"No SIG available") I $O(BSIG(1)) F CCC=1:0 S CCC=$O(BSIG(CCC)) Q:'CCC S MSG(COUNT,(CCC-1))=$G(BSIG(CCC)) 126 Q 127 ; 128 RXR ; 129 F PSORTLP=0:0 S PSORTLP=$O(^PSRX(PSRXIEN,6,PSORTLP)) Q:'PSORTLP D 130 .S LIMIT=1 X NULLFLDS 131 .S FIELD(0)="RXR" 132 .S PSROUTE=$P($G(^PSRX(PSRXIEN,6,PSORTLP,0)),"^",7) I PSROUTE,$D(^PS(51.2,PSROUTE,0)) S RTNAME=$P(^PS(51.2,PSROUTE,0),"^") 133 .S FIELD(1)="^^^"_$G(PSROUTE)_"^"_$G(RTNAME)_"^"_"99PSR" 134 .D SEG 135 Q 136 ; 137 ZCL D ZCL^PSOHLSN2 138 Q 139 ZSC D ZSC^PSOHLSN2 140 Q 141 ; 142 ZRX ; 143 S ZRXFLAG=1 144 S LIMIT=6 X NULLFLDS 145 S FIELD(0)="ZRX" 146 S ZPRE=$P($G(^PSRX(PSRXIEN,"OR1")),"^",3) I ZPRE S FIELD(1)=$P($G(^PSRX(ZPRE,"OR1")),"^",2) 147 I '$G(FIELD(1)),$G(PSORDEDT) S FIELD(1)=$P($G(^PS(52.41,$G(PSORDEDT),0)),"^") 148 S FIELD(2)=$G(PSNOO) 149 I $G(STAT)="SN"!($G(STAT)="RO") S FIELD(3)=$S($G(STAT)="RO"!($G(PSOEDIT)):"E",$G(PSOOPT)=3:"R",1:"N") 150 S FIELD(4)=$P(^PSRX(PSRXIEN,0),"^",11) 151 S PSOCDDUZ=$S($G(PSOROPCH)="PATCH":$P($G(^PSRX(PSRXIEN,"OR1")),"^",5),$G(PSOHUIOR)&($P($G(^PSRX(PSRXIEN,"EXT")),"^")'=""):+$G(PSOCANRC),1:$G(DUZ)) 152 I $G(PSOCDDUZ) S FIELD(5)=PSOCDDUZ_"^"_$P($G(^VA(200,PSOCDDUZ,0)),"^")_"^"_"99NP" 153 I $G(STAT)="ZD",$G(PSODISPP) S FIELD(6)="P" 154 D SEG Q 155 SEG S SEGMENT="" F J=0:1:LIMIT S SEGMENT=$S(SEGMENT="":FIELD(J),1:SEGMENT_"|"_FIELD(J)) 156 S COUNT=COUNT+1,MSG(COUNT)=SEGMENT 157 Q 158 SEND D:$G(PSRXIEN)&($T(EN^PSOHDR)]"")&($G(PSOSSMES)'="CPRSUP") K FIELD D MSG^XQOR("PS EVSEND OR",.MSG) Q 159 .I $G(STAT)="ZC"!($G(STAT)="UC")!($G(STAT)="UD")!($G(STAT)="UH")!($G(STAT)="UR")!($G(STAT)="DE")!($G(STAT)="ZD")!($G(STAT)="SN")!($G(STAT)="Z@") Q 160 .I $G(STAT)="SC",$G(PSSTAT)="ZZ" Q 161 .D EN^PSOHDR("PRES",PSRXIEN) 162 ; 163 NOO ; 164 I $G(PSNOO)="" S PSNOOTX="" Q 165 S PSNOOTX=$S(PSNOO="W":"Written",PSNOO="V":"Verbal",PSNOO="P":"Telephoned",PSNOO="S":"Service Correction",PSNOO="X":"Rejected",PSNOO="D":"Duplicate",PSNOO="I":"Policy",PSNOO="E":"Physician Entered",PSNOO="A":"Auto DC",1:"") Q 166 Q 167 ; 168 DUR(PSODX1,PSODX2) ; 169 N PSODX,PSODX4,PSODX5,PSODX6,PSODX7 S PSODX=$P($G(^PSRX(PSODX1,6,PSODX2,0)),"^",5) 170 I 'PSODX Q PSODX 171 S PSODX4=$L(PSODX),PSODX5=$E(PSODX,PSODX4) 172 S PSODX=$S(PSODX5?1A:PSODX,1:PSODX_"D") 173 S PSODX6=$L(PSODX) 174 S PSODX7=$E(PSODX,PSODX6)_$E(PSODX,1,(PSODX6-1)) 175 Q PSODX7 176 Q
Note:
See TracChangeset
for help on using the changeset viewer.
