- 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/PSOHLDS4.m
r613 r623 1 PSOHLDS4 ;BIR/PWC-Build HL7 Segments for Automated Interface ; 2/13/08 3:21pm 2 ;;7.0;OUTPATIENT PHARMACY;**156,255,279**;DEC 1997;Build 9 3 ;HLFNC supp. by DBIA 10106 4 ;DIC(5 supp. by DBIA 10056 5 ;EN^PSNPPIO supp. by DBIA 3794 6 ;This routine is called from PSOHLDS1 7 ; 8 ;*255 moved tag NTEPMI from PSOHLDS2 9 Q 10 IAM(PSI) ;allergy list segment 11 Q:'$D(DFN)!$D(PAS3) 12 N IAM,IDX,SEV,SEV1,DAT,X,TYP,TYP1,VER,VER1 13 S IAM="",CNT=0,GMRA="0^0^111" D EN1^GMRADPT 14 I $G(GMRAL)="" G ZALQT 15 F AIEN=0:0 S AIEN=$O(GMRAL(AIEN)) Q:'AIEN D 16 .K ADTL D EN1^GMRAOR2(AIEN,"ADTL") S CNT=CNT+1 17 .S TYP1=$P(GMRAL(AIEN),"^",7) 18 .S TYP=$S(TYP1="D":"DRUG",TYP1="F":"FOOD",TYP1="O":"OTHER",TYP1="DF":"DRUG/FOOD",TYP1="DO":"DRUG/OTHER",TYP1="DFO":"DRUG/FOOD/OTHER",1:"""""") 19 .S VER=$S($P(GMRAL(AIEN),"^",4)=1:"VERIFIED",1:"NON-VERIFIED") 20 .S VER1=$S($P(GMRAL(AIEN),"^",4)=1:"C",1:"U") ;confirmed or unconfirmed 21 .S $P(IAM,"|",2)=TYP1_CS_TYP_CS_"LGMR120.8" 22 .S $P(IAM,"|",3)=AIEN_CS_$P(GMRAL(AIEN),"^",2)_CS_"LGMR120.8" 23 .S IDX=$O(ADTL("O","")),X="" S:IDX'="" X=$G(ADTL("O",IDX)) 24 .S DAT=$P(X,"^"),DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"") 25 .S SEV=$P(X,"^",2) S:SEV="" SEV="""""",DAT="" 26 .S SEV1=$S(SEV="MILD":"MI",SEV="MODERATE":"MO",SEV="SEVERE":"SV",1:"U") 27 .S $P(IAM,"|",4)=SEV1 28 .S $P(IAM,"|",5)=$P($P(GMRAL(AIEN),"^",8),";") 29 .S $P(IAM,"|",13)=DAT 30 .S $P(IAM,"|",17)=VER1 31 .S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1 32 .F S IDX=$O(ADTL("O",IDX)) Q:IDX="" D ;repeat for all reactions 33 ..S X=$G(ADTL("O",IDX)),DAT=$P(X,"^"),SEV=$P(X,"^",2) I SEV="" Q 34 ..S DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"") 35 ..S $P(IAM,FS,4)=SEV,$P(IAM,FS,13)=DAT 36 ..S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1 37 S PAS3=1 38 ; 39 ZALQT K GMRAL,ADTL,AIEN,CNT,CNT,GMRA,TYP,TYP1,SEV,SEV1,VER,VER1 40 Q 41 ; 42 ORC(PSI) ;common order segment 43 Q:'$D(DFN) 44 N ORC S ORC="" 45 S $P(ORC,"|",1)="NW" 46 S $P(ORC,"|",2)=IRXN_CS_"OP7.0" 47 S $P(ORC,"|",9)=ISDT 48 S $P(ORC,"|",10)=EBY_CS_EBY1 49 S $P(ORC,"|",12)=PVDR_CS_PVDR1 50 S $P(ORC,"|",13)=$G(PSOLAP) 51 S $P(ORC,"|",15)=EFDT 52 S $P(ORC,"|",16)=$S($G(RXPR(IRXN)):"PARTIAL",$G(RXFL(IRXN)):"REFILL",$G(RXRP(IRXN)):"REPRINT",1:"NEW") 53 S $P(ORC,"|",17)=CLN_CS_CLN1_CS_"99PSC" 54 S $P(ORC,"|",19)=$S(CSINER'="":CSINER_CS_CSINER1,1:"") 55 S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6) 56 S PSZIP=$P(SITE,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:"")) 57 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 58 S $P(ORC,"|",23)="("_$P(SITE,"^",3)_")"_$P(SITE,"^",4) 59 S ^TMP("PSO",$J,PSI)="ORC|"_ORC,PSI=PSI+1 60 Q 61 ; 62 NTEPMI(PSI) ;build NTE segment for PMI sheets ;*255 63 Q:'$D(DFN) N A,I,PREVLN,CURRLN,PMI,PSNMSG,PSDRUG 64 S PSDRUG=+$P(^PSRX(IRXN,0),"^",6),PMI=$$EN^PSNPPIO(PSDRUG,.PSNMSG) 65 Q:'$D(^TMP($J,"PSNPMI")) 66 ;PSO*7*279 Add missing PMI ID(7) to NTE Segment 67 S ^TMP("PSO",$J,PSI)="NTE"_FS_7_FS_FS_^TMP($J,"PSNPMI",0) 68 K A S CNT1=1,CNT=0 69 F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A 70 F I=1:1:11 I $D(^TMP($J,"PSNPMI",A(I))) D 71 .S CNT=$P(^TMP($J,"PSNPMI",A(I),0),"^",3) 72 .S (PREVLN,CURRLN)="" 73 .F J=1:1:CNT D 74 .. S ^TMP("PSO",$J,PSI,CNT1)=^TMP($J,"PSNPMI",A(I),J,0) 75 .. ;PSO*198 check if " " should be inserted 76 .. S CURRLN=^TMP("PSO",$J,PSI,CNT1) 77 .. S:CNT1>1 PREVLN=$S(CNT>1:^TMP("PSO",$J,PSI,CNT1-1),1:"") 78 .. I CNT1>1,$$SPACE^PSOHLDS3(PREVLN,CURRLN) D 79 ... S ^TMP("PSO",$J,PSI,CNT1)=" "_^TMP("PSO",$J,PSI,CNT1) 80 .. I J=1 S $P(^TMP("PSO",$J,PSI,CNT1),":",1)="\H\"_$P(^TMP("PSO",$J,PSI,CNT1),":",1)_"\N\" 81 .. S CNT1=CNT1+1 82 S ^TMP("PSO",$J,PSI,CNT1-1)=^TMP("PSO",$J,PSI,CNT1-1)_FS_"Patient Medication Instructions" 83 S PSI=PSI+1 K A,I,J,CNT,CNT1,^TMP($J,"PSNPMI") 84 Q 1 PSOHLDS4 ;BIR/PWC-Build HL7 Segments for Automated Interface ;11/13/06 1:13pm 2 ;;7.0;OUTPATIENT PHARMACY;**156,255**;DEC 1997;Build 9 3 ;HLFNC supp. by DBIA 10106 4 ;DIC(5 supp. by DBIA 10056 5 ;EN^PSNPPIO supp. by DBIA 3794 6 ;This routine is called from PSOHLDS1 7 ; 8 ;*255 moved tag NTEPMI from PSOHLDS2 9 Q 10 IAM(PSI) ;allergy list segment 11 Q:'$D(DFN)!$D(PAS3) 12 N IAM,IDX,SEV,SEV1,DAT,X,TYP,TYP1,VER,VER1 13 S IAM="",CNT=0,GMRA="0^0^111" D EN1^GMRADPT 14 I $G(GMRAL)="" G ZALQT 15 F AIEN=0:0 S AIEN=$O(GMRAL(AIEN)) Q:'AIEN D 16 .K ADTL D EN1^GMRAOR2(AIEN,"ADTL") S CNT=CNT+1 17 .S TYP1=$P(GMRAL(AIEN),"^",7) 18 .S TYP=$S(TYP1="D":"DRUG",TYP1="F":"FOOD",TYP1="O":"OTHER",TYP1="DF":"DRUG/FOOD",TYP1="DO":"DRUG/OTHER",TYP1="DFO":"DRUG/FOOD/OTHER",1:"""""") 19 .S VER=$S($P(GMRAL(AIEN),"^",4)=1:"VERIFIED",1:"NON-VERIFIED") 20 .S VER1=$S($P(GMRAL(AIEN),"^",4)=1:"C",1:"U") ;confirmed or unconfirmed 21 .S $P(IAM,"|",2)=TYP1_CS_TYP_CS_"LGMR120.8" 22 .S $P(IAM,"|",3)=AIEN_CS_$P(GMRAL(AIEN),"^",2)_CS_"LGMR120.8" 23 .S IDX=$O(ADTL("O","")),X="" S:IDX'="" X=$G(ADTL("O",IDX)) 24 .S DAT=$P(X,"^"),DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"") 25 .S SEV=$P(X,"^",2) S:SEV="" SEV="""""",DAT="" 26 .S SEV1=$S(SEV="MILD":"MI",SEV="MODERATE":"MO",SEV="SEVERE":"SV",1:"U") 27 .S $P(IAM,"|",4)=SEV1 28 .S $P(IAM,"|",5)=$P($P(GMRAL(AIEN),"^",8),";") 29 .S $P(IAM,"|",13)=DAT 30 .S $P(IAM,"|",17)=VER1 31 .S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1 32 .F S IDX=$O(ADTL("O",IDX)) Q:IDX="" D ;repeat for all reactions 33 ..S X=$G(ADTL("O",IDX)),DAT=$P(X,"^"),SEV=$P(X,"^",2) I SEV="" Q 34 ..S DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"") 35 ..S $P(IAM,FS,4)=SEV,$P(IAM,FS,13)=DAT 36 ..S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1 37 S PAS3=1 38 ; 39 ZALQT K GMRAL,ADTL,AIEN,CNT,CNT,GMRA,TYP,TYP1,SEV,SEV1,VER,VER1 40 Q 41 ; 42 ORC(PSI) ;common order segment 43 Q:'$D(DFN) 44 N ORC S ORC="" 45 S $P(ORC,"|",1)="NW" 46 S $P(ORC,"|",2)=IRXN_CS_"OP7.0" 47 S $P(ORC,"|",9)=ISDT 48 S $P(ORC,"|",10)=EBY_CS_EBY1 49 S $P(ORC,"|",12)=PVDR_CS_PVDR1 50 S $P(ORC,"|",13)=$G(PSOLAP) 51 S $P(ORC,"|",15)=EFDT 52 S $P(ORC,"|",16)=$S($G(RXPR(IRXN)):"PARTIAL",$G(RXFL(IRXN)):"REFILL",$G(RXRP(IRXN)):"REPRINT",1:"NEW") 53 S $P(ORC,"|",17)=CLN_CS_CLN1_CS_"99PSC" 54 S $P(ORC,"|",19)=$S(CSINER'="":CSINER_CS_CSINER1,1:"") 55 S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6) 56 S PSZIP=$P(SITE,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:"")) 57 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 58 S $P(ORC,"|",23)="("_$P(SITE,"^",3)_")"_$P(SITE,"^",4) 59 S ^TMP("PSO",$J,PSI)="ORC|"_ORC,PSI=PSI+1 60 Q 61 ; 62 NTEPMI(PSI) ;build NTE segment for PMI sheets ;*255 63 Q:'$D(DFN) N A,I,PREVLN,CURRLN,PMI,PSNMSG,PSDRUG 64 S PSDRUG=+$P(^PSRX(IRXN,0),"^",6),PMI=$$EN^PSNPPIO(PSDRUG,.PSNMSG) 65 Q:'$D(^TMP($J,"PSNPMI")) 66 S ^TMP("PSO",$J,PSI)="NTE"_FS_^TMP($J,"PSNPMI",0)_FS 67 K A S CNT1=1,CNT=0 68 F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A 69 F I=1:1:11 I $D(^TMP($J,"PSNPMI",A(I))) D 70 .S CNT=$P(^TMP($J,"PSNPMI",A(I),0),"^",3) 71 .S (PREVLN,CURRLN)="" 72 .F J=1:1:CNT D 73 .. S ^TMP("PSO",$J,PSI,CNT1)=^TMP($J,"PSNPMI",A(I),J,0) 74 .. ;PSO*198 check if " " should be inserted 75 .. S CURRLN=^TMP("PSO",$J,PSI,CNT1) 76 .. S:CNT1>1 PREVLN=$S(CNT>1:^TMP("PSO",$J,PSI,CNT1-1),1:"") 77 .. I CNT1>1,$$SPACE^PSOHLDS3(PREVLN,CURRLN) D 78 ... S ^TMP("PSO",$J,PSI,CNT1)=" "_^TMP("PSO",$J,PSI,CNT1) 79 .. I J=1 S $P(^TMP("PSO",$J,PSI,CNT1),":",1)="\H\"_$P(^TMP("PSO",$J,PSI,CNT1),":",1)_"\N\" 80 .. S CNT1=CNT1+1 81 S ^TMP("PSO",$J,PSI,CNT1-1)=^TMP("PSO",$J,PSI,CNT1-1)_FS_"Patient Medication Instructions" 82 S PSI=PSI+1 K A,I,J,CNT,CNT1,^TMP($J,"PSNPMI") 83 Q
Note:
See TracChangeset
for help on using the changeset viewer.
