source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLDS4.m@ 975

Last change on this file since 975 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.6 KB
Line 
1PSOHLDS4 ;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
10IAM(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 ;
39ZALQT K GMRAL,ADTL,AIEN,CNT,CNT,GMRA,TYP,TYP1,SEV,SEV1,VER,VER1
40 Q
41 ;
42ORC(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 ;
62NTEPMI(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 TracBrowser for help on using the repository browser.