- Timestamp:
- Dec 4, 2009, 12:11:15 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLSNC.m
r613 r623 1 PSOHLSNC 2 ;;7.0;OUTPATIENT PHARMACY;**111,157,143,225**;DEC 1997;Build 29 3 4 5 6 7 8 9 10 11 12 13 14 EN(PSOPND,PSOPNDST,PSOPNDPT) 15 16 17 18 19 20 21 22 23 24 PID 25 26 27 28 29 30 31 PV1 32 33 34 35 36 37 38 DG1 39 40 41 42 43 44 45 46 47 48 49 50 51 52 ORC 53 54 55 56 57 58 59 60 61 62 63 64 65 RXO 66 67 68 69 70 71 72 RXE 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 RXR 113 114 115 116 117 118 119 120 121 122 123 ZRX 124 125 126 127 128 129 130 ZCL 131 132 133 134 135 136 137 ..F JJJ=2:1:9S EI=$P(INODE,U,JJJ) D138 139 140 141 142 143 144 145 146 147 .F I=2,3,4,1,5,6,7S PSOXFLD(3)=$P(EI,U,I) D148 .. S PSOXFLD(2)=$S(I=2:1,I=3:2,I=4:4,I=1:5,I=5:6,I=6:7,I=7:8,1:"") D SEG149 150 ZSC 151 152 153 154 155 156 157 SEG 158 159 160 1 PSOHLSNC ;BIR/RTR - Send CHCS message to CPRS ;07/03/02 2 ;;7.0;OUTPATIENT PHARMACY;**111,157,143**;DEC 1997 3 ;External reference to ^PS(50.7 supported by DBIA 2223 4 ;External reference to ^PS(51.2 supported by DBIA 2226 5 ;External reference to ^PSDRUG( supported by DBIA 221 6 ;External reference to ^PS(50.607 supported by DBIA 2221 7 ;External reference to ^PS(50.606 supported by DBIA 2174 8 ;External reference to EN^PSSUTIL1 supported by DBIA 3179 9 ; 10 ;PSOPND=Internal number from 52.41 11 ;PSOPNDST=Order Control Code Status 12 ;PSOPNDPT=Pharmacy Status 13 ; 14 EN(PSOPND,PSOPNDST,PSOPNDPT) ; 15 N MSG,PSOHLIP,PSOHLIPX,PSOHLIPC,PSOHLTTL,PSOHUTL,PSOHND,PSOHNDD,PSOHNDU,PSONFLD,PSOXFLD,PSOLIMIT,PSONJJ,PSOHJJ,PSOHCT,PSOSEGMT,PSOHENT,PSOHPRO,PSOHIM,PSOHPC,PSOHPCTX,PSOHRT,PSOHRTE,PSOHRTEN,PSOHRTX,Y,DA,DIQ,DR 16 I $G(PSOPND)=""!($G(PSOPNDST)="") Q 17 I '$D(^PS(52.41,+$G(PSOPND),0)) Q 18 S PSONFLD="F PSONJJ=0:1:PSOLIMIT S PSOXFLD(PSONJJ)=""""" 19 S PSOHCT=1 20 D INIT^PSOHLSN 21 D PID,PV1,ORC,RXO,RXE,RXR,ZRX,DG1,ZCL 22 D MSG^XQOR("PS EVSEND OR",.MSG) 23 Q 24 PID ;Build PID segment 25 S PSOLIMIT=5 X PSONFLD 26 ;What about this ICN number? 27 S PSOXFLD(0)="PID" 28 S PSOXFLD(3)=$P($G(^PS(52.41,PSOPND,0)),"^",2) 29 D SEG 30 Q 31 PV1 ;Build PV1 segment 32 S PSOLIMIT=19 X PSONFLD 33 S PSOXFLD(0)="PV1" 34 S PSOXFLD(2)="O" 35 I $P($G(^PS(52.41,PSOPND,0)),"^",13) S PSOXFLD(3)=$P(^(0),"^",13) 36 D SEG 37 Q 38 DG1 ;Build DG1 segment 39 ;future use; chcs does not send ICD-9 codes. 40 Q:'$D(^PS(52.41,PSOPND,"ICD")) 41 S PSOLIMIT=4 X PSONFLD 42 S PSOXFLD(0)="DG1" 43 N LP,VDG,FLAG,DXDESC,DG 44 S FLAG="",PSOXFLD(4)="",PSOXFLD(2)="" 45 F LP=1:1:8 Q:'$D(^PS(52.41,PSOPND,"ICD",LP,0)) D 46 . S VDG="",VDG=^PS(52.41,PSOPND,"ICD",LP,0) Q:$P(VDG,U,1)="" 47 . S (DG,DXDESC)="" 48 . S DXDESC=$$GET1^DIQ(80,$P(VDG,U,1)_",",10),PSOXFLD(1)=LP 49 . S PSOXFLD(3)=$P(VDG,U,1)_U_DXDESC_U_"80"_U_$$GET1^DIQ(80,$P(VDG,U,1)_",",.01)_U_DXDESC_U_"ICD9" 50 . D SEG 51 Q 52 ORC ;Build ORC segment 53 S PSOLIMIT=15 X PSONFLD 54 S PSOXFLD(0)="ORC" 55 S PSOXFLD(1)=$G(PSOPNDST) 56 S PSOXFLD(3)=PSOPND_"S^PS" 57 S PSOXFLD(5)=$G(PSOPNDPT) 58 S X=$P($G(^PS(52.41,PSOPND,0)),"^",6) I X S PSOXFLD(9)=$$FMTHL7^XLFDT(X) 59 S PSOHENT=$P($G(^PS(52.41,PSOPND,0)),"^",4) I PSOHENT K ^UTILITY("DIQ1",$J) S DIC=200,DR=.01,DA=PSOHENT,DIQ(0)="E" D EN^DIQ1 S PSOXFLD(10)=PSOHENT_"^"_$P($G(^UTILITY("DIQ1",$J,200,PSOHENT,.01,"E")),"^") 60 S PSOHPRO=$P($G(^PS(52.41,PSOPND,0)),"^",5) I PSOHPRO K ^UTILITY("DIQ1",$J) S DIC=200,DR=.01,DA=PSOHPRO,DIQ(0)="E" D EN^DIQ1 S PSOXFLD(12)=PSOHPRO_"^"_$P($G(^UTILITY("DIQ1",$J,200,PSOHPRO,.01,"E")),"^") 61 K ^UTILITY("DIQ1",$J) 62 S X=$P($G(^PS(52.41,PSOPND,0)),"^",12) I X S PSOXFLD(15)=$$FMTHL7^XLFDT(X) 63 D SEG 64 Q 65 RXO ;Build RXO segment 66 S PSOLIMIT=1 X PSONFLD 67 S PSOXFLD(0)="RXO" 68 S PSOHITM=$P($G(^PS(52.41,PSOPND,0)),"^",8) 69 S PSOXFLD(1)=$S($G(PSOHITM):"^^^"_PSOHITM_"^"_$P($G(^PS(50.7,+$G(PSOHITM),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")_"^99PSP",1:"^^^^^") 70 D SEG 71 Q 72 RXE ;Build RXE segment 73 K PSOXFLD S PSOLIMIT=26 X PSONFLD 74 S PSOXFLD(0)="RXE" 75 ;No Quantity Timing, since the Sig is entered as free text 76 S PSOHNDD=$P($G(^PS(52.41,PSOPND,0)),"^",9) 77 S PSOHND="" I PSOHNDD S PSOHND=$G(^PSDRUG(PSOHNDD,"ND")) 78 S PSOXFLD(2)=$S($P(PSOHND,"^")&($P(PSOHND,"^",3)):$P(PSOHND,"^")_"."_$P(PSOHND,"^",3)_"^"_$P(PSOHND,"^",2)_"^"_"99NDF",1:"^^")_"^"_$G(PSOHNDD)_"^"_$S($G(PSOHNDD):$P($G(^PSDRUG(PSOHNDD,0)),"^"),1:"")_"^"_"99PSD" 79 I $P(PSOHND,"^"),$P(PSOHND,"^",3) D 80 .I $T(^PSNAPIS)]"" S PSOHNDU=$$DFSU^PSNAPIS($P(PSOHND,"^"),$P(PSOHND,"^",3)) S PSOXFLD(5)="^^^"_$P($G(PSOHNDU),"^",5)_"^"_$P($G(PSOHNDU),"^",6)_"^"_"99PSU" 81 I $G(PSOHITM) S PSOXFLD(6)="^^^"_$P($G(^PS(50.7,$G(PSOHITM),0)),"^",2)_"^"_$P($G(^PS(50.606,+$P($G(^PS(50.7,$G(PSOHITM),0)),"^",2),0)),"^")_"^"_"99PSF" 82 S PSOXFLD(10)=$P(^PS(52.41,PSOPND,0),"^",10) 83 S PSOXFLD(12)=$P(^PS(52.41,PSOPND,0),"^",11) 84 S PSOXFLD(22)=$P(^PS(52.41,PSOPND,0),"^",22) 85 I $G(PSOHNDD) S PSOHUTL=$$EN^PSSUTIL1(PSOHNDD) S PSOXFLD(25)=$S($E($P(PSOHUTL,"|"),1)=".":"0",1:"")_$P(PSOHUTL,"|"),PSOXFLD(26)=$P(PSOHUTL,"|",2) 86 ;Create RXE segment, can possibly go over 245 in length 87 S PSOHCT=PSOHCT+1 88 S (PSOHLIPX,PSOHLIPC,PSOHLTTL)=0,PSOHLIP="" F S PSOHLIP=$O(PSOXFLD(PSOHLIP)) Q:PSOHLIP="" D 89 .I PSOHLIP S PSOXFLD(PSOHLIP)="|"_PSOXFLD(PSOHLIP) 90 .I PSOHLTTL+$L(PSOXFLD(PSOHLIP))<246 D S PSOHLTTL=PSOHLTTL+$L(PSOXFLD(PSOHLIP)) Q 91 ..I 'PSOHLIPX S MSG(PSOHCT)=$G(MSG(PSOHCT))_PSOXFLD(PSOHLIP) Q 92 ..S MSG(PSOHCT,PSOHLIPX)=$G(MSG(PSOHCT,PSOHLIPX))_PSOXFLD(PSOHLIP) 93 .S PSOHLICP=245-PSOHLTTL 94 .I 'PSOHLIPX D S PSOHLTTL=$L(MSG(PSOHCT,PSOHLIPX)) Q 95 ..S MSG(PSOHCT)=$G(MSG(PSOHCT))_$E(PSOXFLD(PSOHLIP),1,PSOHLICP) 96 ..S PSOHLIPX=1,MSG(PSOHCT,PSOHLIPX)=$E(PSOXFLD(PSOHLIP),(PSOHLICP+1),999) 97 .S MSG(PSOHCT,PSOHLIPX)=$G(MSG(PSOHCT,PSOHLIPX))_$E(PSOXFLD(PSOHLIP),1,PSOHLICP) 98 .S PSOHLIPX=PSOHLIPX+1,MSG(PSOHCT,PSOHLIPX)=$E(PSOXFLD(PSOHLIP),(PSOHLICP+1),999) 99 .S PSOHLTTL=$L(MSG(PSOHCT,PSOHLIPX)) 100 ;Set NTE segments 101 S PSOHPCT=0,PSOHCT=PSOHCT+1 I $O(^PS(52.41,PSOPND,3,0)) F PSOHPC=0:0 S PSOHPC=$O(^PS(52.41,PSOPND,3,PSOHPC)) Q:'PSOHPC D 102 .I $G(^PS(52.41,PSOPND,3,PSOHPC,0))="" Q 103 .I 'PSOHPCT S MSG(PSOHCT)="NTE|6||"_$G(^PS(52.41,PSOPND,3,PSOHPC,0)) S PSOHPCT=1 Q 104 .S MSG(PSOHCT,PSOHPCT)=$G(^PS(52.41,PSOPND,3,PSOHPC,0)),PSOHPCT=PSOHPCT+1 105 I 'PSOHPCT S PSOHCT=PSOHCT-1 106 S PSOHCT=PSOHCT+1,PSOHPCT=0 I $O(^PS(52.41,PSOPND,"SIG",0)) F PSOHPC=0:0 S PSOHPC=$O(^PS(52.41,PSOPND,"SIG",PSOHPC)) Q:'PSOHPC D 107 .I $G(^PS(52.41,PSOPND,"SIG",PSOHPC,0))="" Q 108 .I 'PSOHPCT S MSG(PSOHCT)="NTE|21||"_$G(^PS(52.41,PSOPND,"SIG",PSOHPC,0)) S PSOHPCT=1 Q 109 .S MSG(PSOHCT,PSOHPCT)=$G(^PS(52.41,PSOPND,"SIG",PSOHPC,0)),PSOHPCT=PSOHPCT+1 110 I 'PSOHPCT S MSG(PSOHCT)="NTE|21||"_"No SIG available" 111 Q 112 RXR ;Build RXR segment 113 S PSOHRTX="" F PSOHRT=0:0 S PSOHRT=$O(^PS(52.41,PSOPND,1,PSOHRT)) Q:'PSOHRT D 114 .S PSOHRTX=1 115 .S PSOLIMIT=1 X PSONFLD 116 .S PSOXFLD(0)="RXR" 117 .S PSOHRTEN="" 118 .S PSOHRTE=$P($G(^PS(52.41,PSOPND,1,PSOHRT,1)),"^",8) I PSOHRTE,$D(^PS(51.2,PSOHRTE,0)) S PSOHRTEN=$P($G(^(0)),"^") 119 .S PSOXFLD(1)="^^^"_$G(PSOHRTE)_"^"_$G(PSOHRTEN)_"^"_"99PSR" 120 .D SEG 121 I '$G(PSOHRTX) S PSOLIMIT=1 X PSONFLD S PSOXFLD(0)="RXR",PSOXFLD(1)="^^^^^99PSR" D SEG 122 Q 123 ZRX ;Build ZRX segment 124 S PSOLIMIT=6 X PSONFLD 125 S PSOXFLD(0)="ZRX" 126 S PSOXFLD(3)="N" 127 S PSOXFLD(4)=$P($G(^PS(52.41,PSOPND,0)),"^",17) 128 D SEG 129 Q 130 ZCL ;Build ZCL segment 131 N I,JJJ,INODE,EI 132 S PSOXFLD(0)="ZCL",PSOLIMIT=3 X PSONFLD 133 I $D(^PS(52.41,PSOPND,"ICD")) D 134 .F I=1:1:8 D 135 ..Q:'$D(^PS(52.41,PSOPND,"ICD",I,0)) 136 ..S INODE="",INODE=^PS(52.41,PSOPND,"ICD",I,0) 137 ..F JJJ=2:1:8 S EI=$P(INODE,U,JJJ) D 138 ...S PSOXFLD(1)=I,PSOXFLD(2)=JJJ-1,PSOXFLD(3)=EI 139 ...;I JJJ=4 S EI=$S(EI=1:"SC",EI=0:"NSC",1:"") S PSOXFLD(3)=EI 140 ...D SEG 141 E D ;if no ICD node, send one ZCL segment 142 .S PSOXFLD(0)="ZCL",PSOXFLD(1)=1,PSOXFLD(2)=3 143 .S PSOXFLD(3)=$S($P(^PS(52.41,PSOPND,0),"^",16)="SC":1,$P(^(0),"^",16)="NSC":0,1:"") 144 .D SEG 145 .Q:'$D(^PS(52.41,PSOPND,"IBQ")) 146 .S EI=^PS(52.41,PSOPND,"IBQ") 147 .F I=2,3,4,1,5,6 S PSOXFLD(3)=$P(EI,U,I) D 148 .. S PSOXFLD(2)=$S(I=2:1,I=3:2,I=4:4,I=1:5,I=5:6,I=6:7,1:"") D SEG 149 Q 150 ZSC ;Build ZSC segment 151 S PSOLIMIT=6 X PSONFLD 152 S PSOXFLD(0)="ZSC" 153 S PSOXFLD(1)=$S($P(^PS(52.41,PSOPND,0),"^",16)="SC":1,$P(^(0),"^",16)="NSC":0,1:"") 154 S PSOXFLD(2)=$P($G(^PS(52.41,PSOPND,"IBQ")),"^"),PSOXFLD(3)=$P($G(^("IBQ")),"^",2),PSOXFLD(4)=$P($G(^("IBQ")),"^",3),PSOXFLD(5)=$P($G(^("IBQ")),"^",4),PSOXFLD(6)=$P($G(^("IBQ")),"^",5),PSOXFLD(7)=$P($G(^("IBQ")),"^",6) 155 D SEG 156 Q 157 SEG ; 158 S PSOSEGMT="" F PSOHJJ=0:1:PSOLIMIT S PSOSEGMT=$S(PSOSEGMT="":PSOXFLD(PSOHJJ),1:PSOSEGMT_"|"_PSOXFLD(PSOHJJ)) 159 S PSOHCT=PSOHCT+1,MSG(PSOHCT)=PSOSEGMT 160 Q
Note:
See TracChangeset
for help on using the changeset viewer.
