- PSOHLDS4 ;BIR/PWC - Build HL7 Segments for Automated Interface ; 2/13/08 3:21pm
- ;;7.0;OUTPATIENT PHARMACY;**156,255,279,385,505,617**;DEC 1997;Build 110
- ;HLFNC supp. by DBIA 10106
- ;DIC(5 supp. by DBIA 10056
- ;EN^PSNPPIO supp. by DBIA 3794
- ;This routine is called from PSOHLDS1
- ;
- ;*255 moved tag NTEPMI from PSOHLDS2
- Q
- IAM(PSI) ;allergy list segment
- Q:'$D(DFN)!$D(PAS3)
- N IAM,IDX,SEV,SEV1,DAT,X,TYP,TYP1,VER,VER1
- S IAM="",CNT=0,GMRA="0^0^111" D EN1^GMRADPT
- I $G(GMRAL)="" G ZALQT
- F AIEN=0:0 S AIEN=$O(GMRAL(AIEN)) Q:'AIEN D
- .K ADTL D EN1^GMRAOR2(AIEN,"ADTL") S CNT=CNT+1
- .S TYP1=$P(GMRAL(AIEN),"^",7)
- .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:"""""")
- .S VER=$S($P(GMRAL(AIEN),"^",4)=1:"VERIFIED",1:"NON-VERIFIED")
- .S VER1=$S($P(GMRAL(AIEN),"^",4)=1:"C",1:"U") ;confirmed or unconfirmed
- .S $P(IAM,"|",2)=TYP1_CS_TYP_CS_"LGMR120.8"
- .S $P(IAM,"|",3)=AIEN_CS_$P(GMRAL(AIEN),"^",2)_CS_"LGMR120.8"
- .S IDX=$O(ADTL("O","")),X="" S:IDX'="" X=$G(ADTL("O",IDX))
- .S DAT=$P(X,"^"),DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"")
- .S SEV=$P(X,"^",2) S:SEV="" SEV="""""",DAT=""
- .S SEV1=$S(SEV="MILD":"MI",SEV="MODERATE":"MO",SEV="SEVERE":"SV",1:"U")
- .S $P(IAM,"|",4)=SEV1
- .S $P(IAM,"|",5)=$P($P(GMRAL(AIEN),"^",8),";")
- .S $P(IAM,"|",13)=DAT
- .S $P(IAM,"|",17)=VER1
- .S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1
- .F S IDX=$O(ADTL("O",IDX)) Q:IDX="" D ;repeat for all reactions
- ..S X=$G(ADTL("O",IDX)),DAT=$P(X,"^"),SEV=$P(X,"^",2) I SEV="" Q
- ..S DAT=$S(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"")
- ..S $P(IAM,FS,4)=SEV,$P(IAM,FS,13)=DAT
- ..S ^TMP("PSO",$J,PSI)="IAM|"_IAM,PSI=PSI+1
- S PAS3=1
- ;
- ZALQT K GMRAL,ADTL,AIEN,CNT,CNT,GMRA,TYP,TYP1,SEV,SEV1,VER,VER1
- Q
- ;
- ORC(PSI) ;common order segment
- Q:'$D(DFN)
- N ORC S ORC=""
- S $P(ORC,"|",1)="NW"
- S $P(ORC,"|",2)=IRXN_CS_"OP7.0"
- S $P(ORC,"|",9)=ISDT
- S $P(ORC,"|",10)=EBY_CS_EBY1
- S $P(ORC,"|",12)=PVDR_CS_PVDR1
- S $P(ORC,"|",13)=$G(PSOLAP)
- S $P(ORC,"|",15)=EFDT
- S $P(ORC,"|",16)=$S($G(RXPR(IRXN)):"PARTIAL",$G(RXFL(IRXN)):"REFILL",$G(RXRP(IRXN)):"REPRINT",1:"NEW")
- S $P(ORC,"|",17)=CLN_CS_CLN1_CS_"99PSC"
- S $P(ORC,"|",19)=$S(CSINER'="":CSINER_CS_CSINER1,1:"")
- S $P(ORC,"|",20)=$S($$STATUS^PSOBPSUT(IRXN,$G(RXFL(IRXN)))]"":"VA5",1:"") ; Added ePharmacy indicator (VA5) BNT; PSO*7*385
- S $P(ORC,"|",21)=$P(SITE,"^",1)_CS_CS_$P(SITE,"^",6)
- S PSZIP=$P(SITE,"^",5),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)
- ;/BLB/ PSO*7.0*505 ;ADDED LOGIC TO ADD DIGITAL SIGNATURE FOR CONTROLLED SUBSTANCE PRESCRIPTIONS (eRx and CPRS)
- I $$GET1^DIQ(52,IRXN,310,"I")!$$GET1^DIQ(52,IRXN,312,"I") S $P(ORC,"|",30)="EL"
- S ^TMP("PSO",$J,PSI)="ORC|"_ORC,PSI=PSI+1
- Q
- ;
- NTEPMI(PSI) ;build NTE segment for PMI sheets ;*255
- Q:'$D(DFN) N A,I,PREVLN,CURRLN,PMI,PSNMSG,PSDRUG
- S PSDRUG=+$P(^PSRX(IRXN,0),"^",6),PMI=$$EN^PSNPPIO(PSDRUG,.PSNMSG)
- Q:'$D(^TMP($J,"PSNPMI"))
- ;PSO*7*279 Add missing PMI ID(7) to NTE Segment
- S ^TMP("PSO",$J,PSI)="NTE"_FS_7_FS_FS_^TMP($J,"PSNPMI",0)
- K A S CNT1=1,CNT=0
- F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A
- F I=1:1:11 I $D(^TMP($J,"PSNPMI",A(I))) D
- .S CNT=$P(^TMP($J,"PSNPMI",A(I),0),"^",3)
- .S (PREVLN,CURRLN)=""
- .F J=1:1:CNT D
- .. S ^TMP("PSO",$J,PSI,CNT1)=^TMP($J,"PSNPMI",A(I),J,0)
- .. ;PSO*198 check if " " should be inserted
- .. S CURRLN=^TMP("PSO",$J,PSI,CNT1)
- .. S:CNT1>1 PREVLN=$S(CNT>1:^TMP("PSO",$J,PSI,CNT1-1),1:"")
- .. I CNT1>1,$$SPACE^PSOHLDS3(PREVLN,CURRLN) D
- ... S ^TMP("PSO",$J,PSI,CNT1)=" "_^TMP("PSO",$J,PSI,CNT1)
- .. I J=1 S $P(^TMP("PSO",$J,PSI,CNT1),":",1)="\H\"_$P(^TMP("PSO",$J,PSI,CNT1),":",1)_"\N\"
- .. S CNT1=CNT1+1
- S ^TMP("PSO",$J,PSI,CNT1-1)=^TMP("PSO",$J,PSI,CNT1-1)_FS_"Patient Medication Instructions"
- S PSI=PSI+1 K A,I,J,CNT,CNT1,^TMP($J,"PSNPMI")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHLDS4 4126 printed Feb 18, 2025@23:56:15 Page 2
- PSOHLDS4 ;BIR/PWC - Build HL7 Segments for Automated Interface ; 2/13/08 3:21pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**156,255,279,385,505,617**;DEC 1997;Build 110
- +2 ;HLFNC supp. by DBIA 10106
- +3 ;DIC(5 supp. by DBIA 10056
- +4 ;EN^PSNPPIO supp. by DBIA 3794
- +5 ;This routine is called from PSOHLDS1
- +6 ;
- +7 ;*255 moved tag NTEPMI from PSOHLDS2
- +8 QUIT
- IAM(PSI) ;allergy list segment
- +1 if '$DATA(DFN)!$DATA(PAS3)
- QUIT
- +2 NEW IAM,IDX,SEV,SEV1,DAT,X,TYP,TYP1,VER,VER1
- +3 SET IAM=""
- SET CNT=0
- SET GMRA="0^0^111"
- DO EN1^GMRADPT
- +4 IF $GET(GMRAL)=""
- GOTO ZALQT
- +5 FOR AIEN=0:0
- SET AIEN=$ORDER(GMRAL(AIEN))
- if 'AIEN
- QUIT
- Begin DoDot:1
- +6 KILL ADTL
- DO EN1^GMRAOR2(AIEN,"ADTL")
- SET CNT=CNT+1
- +7 SET TYP1=$PIECE(GMRAL(AIEN),"^",7)
- +8 SET TYP=$SELECT(TYP1="D":"DRUG",TYP1="F":"FOOD",TYP1="O":"OTHER",TYP1="DF":"DRUG/FOOD",TYP1="DO":"DRUG/OTHER",TYP1="DFO":"DRUG/FOOD/OTHER",1:"""""")
- +9 SET VER=$SELECT($PIECE(GMRAL(AIEN),"^",4)=1:"VERIFIED",1:"NON-VERIFIED")
- +10 ;confirmed or unconfirmed
- SET VER1=$SELECT($PIECE(GMRAL(AIEN),"^",4)=1:"C",1:"U")
- +11 SET $PIECE(IAM,"|",2)=TYP1_CS_TYP_CS_"LGMR120.8"
- +12 SET $PIECE(IAM,"|",3)=AIEN_CS_$PIECE(GMRAL(AIEN),"^",2)_CS_"LGMR120.8"
- +13 SET IDX=$ORDER(ADTL("O",""))
- SET X=""
- if IDX'=""
- SET X=$GET(ADTL("O",IDX))
- +14 SET DAT=$PIECE(X,"^")
- SET DAT=$SELECT(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"")
- +15 SET SEV=$PIECE(X,"^",2)
- if SEV=""
- SET SEV=""""""
- SET DAT=""
- +16 SET SEV1=$SELECT(SEV="MILD":"MI",SEV="MODERATE":"MO",SEV="SEVERE":"SV",1:"U")
- +17 SET $PIECE(IAM,"|",4)=SEV1
- +18 SET $PIECE(IAM,"|",5)=$PIECE($PIECE(GMRAL(AIEN),"^",8),";")
- +19 SET $PIECE(IAM,"|",13)=DAT
- +20 SET $PIECE(IAM,"|",17)=VER1
- +21 SET ^TMP("PSO",$JOB,PSI)="IAM|"_IAM
- SET PSI=PSI+1
- +22 ;repeat for all reactions
- FOR
- SET IDX=$ORDER(ADTL("O",IDX))
- if IDX=""
- QUIT
- Begin DoDot:2
- +23 SET X=$GET(ADTL("O",IDX))
- SET DAT=$PIECE(X,"^")
- SET SEV=$PIECE(X,"^",2)
- IF SEV=""
- QUIT
- +24 SET DAT=$SELECT(DAT'="":$$HLDATE^HLFNC(DAT,"DT"),1:"")
- +25 SET $PIECE(IAM,FS,4)=SEV
- SET $PIECE(IAM,FS,13)=DAT
- +26 SET ^TMP("PSO",$JOB,PSI)="IAM|"_IAM
- SET PSI=PSI+1
- End DoDot:2
- End DoDot:1
- +27 SET PAS3=1
- +28 ;
- ZALQT KILL GMRAL,ADTL,AIEN,CNT,CNT,GMRA,TYP,TYP1,SEV,SEV1,VER,VER1
- +1 QUIT
- +2 ;
- ORC(PSI) ;common order segment
- +1 if '$DATA(DFN)
- QUIT
- +2 NEW ORC
- SET ORC=""
- +3 SET $PIECE(ORC,"|",1)="NW"
- +4 SET $PIECE(ORC,"|",2)=IRXN_CS_"OP7.0"
- +5 SET $PIECE(ORC,"|",9)=ISDT
- +6 SET $PIECE(ORC,"|",10)=EBY_CS_EBY1
- +7 SET $PIECE(ORC,"|",12)=PVDR_CS_PVDR1
- +8 SET $PIECE(ORC,"|",13)=$GET(PSOLAP)
- +9 SET $PIECE(ORC,"|",15)=EFDT
- +10 SET $PIECE(ORC,"|",16)=$SELECT($GET(RXPR(IRXN)):"PARTIAL",$GET(RXFL(IRXN)):"REFILL",$GET(RXRP(IRXN)):"REPRINT",1:"NEW")
- +11 SET $PIECE(ORC,"|",17)=CLN_CS_CLN1_CS_"99PSC"
- +12 SET $PIECE(ORC,"|",19)=$SELECT(CSINER'="":CSINER_CS_CSINER1,1:"")
- +13 ; Added ePharmacy indicator (VA5) BNT; PSO*7*385
- SET $PIECE(ORC,"|",20)=$SELECT($$STATUS^PSOBPSUT(IRXN,$GET(RXFL(IRXN)))]"":"VA5",1:"")
- +14 SET $PIECE(ORC,"|",21)=$PIECE(SITE,"^",1)_CS_CS_$PIECE(SITE,"^",6)
- +15 SET PSZIP=$PIECE(SITE,"^",5)
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- +16 SET $PIECE(ORC,"|",22)=$PIECE(SITE,"^",2)_CS_CS_$PIECE(SITE,"^",7)_CS_$SELECT($DATA(^DIC(5,+$PIECE(SITE,"^",8),0)):$PIECE(^(0),"^",2),1:"UKN")_CS_PSOHZIP
- +17 SET $PIECE(ORC,"|",23)="("_$PIECE(SITE,"^",3)_")"_$PIECE(SITE,"^",4)
- +18 ;/BLB/ PSO*7.0*505 ;ADDED LOGIC TO ADD DIGITAL SIGNATURE FOR CONTROLLED SUBSTANCE PRESCRIPTIONS (eRx and CPRS)
- +19 IF $$GET1^DIQ(52,IRXN,310,"I")!$$GET1^DIQ(52,IRXN,312,"I")
- SET $PIECE(ORC,"|",30)="EL"
- +20 SET ^TMP("PSO",$JOB,PSI)="ORC|"_ORC
- SET PSI=PSI+1
- +21 QUIT
- +22 ;
- NTEPMI(PSI) ;build NTE segment for PMI sheets ;*255
- +1 if '$DATA(DFN)
- QUIT
- NEW A,I,PREVLN,CURRLN,PMI,PSNMSG,PSDRUG
- +2 SET PSDRUG=+$PIECE(^PSRX(IRXN,0),"^",6)
- SET PMI=$$EN^PSNPPIO(PSDRUG,.PSNMSG)
- +3 if '$DATA(^TMP($JOB,"PSNPMI"))
- QUIT
- +4 ;PSO*7*279 Add missing PMI ID(7) to NTE Segment
- +5 SET ^TMP("PSO",$JOB,PSI)="NTE"_FS_7_FS_FS_^TMP($JOB,"PSNPMI",0)
- +6 KILL A
- SET CNT1=1
- SET CNT=0
- +7 FOR A="W","U","H","S","M","P","I","O","N","D","R"
- SET CNT=CNT+1
- SET A(CNT)=A
- +8 FOR I=1:1:11
- IF $DATA(^TMP($JOB,"PSNPMI",A(I)))
- Begin DoDot:1
- +9 SET CNT=$PIECE(^TMP($JOB,"PSNPMI",A(I),0),"^",3)
- +10 SET (PREVLN,CURRLN)=""
- +11 FOR J=1:1:CNT
- Begin DoDot:2
- +12 SET ^TMP("PSO",$JOB,PSI,CNT1)=^TMP($JOB,"PSNPMI",A(I),J,0)
- +13 ;PSO*198 check if " " should be inserted
- +14 SET CURRLN=^TMP("PSO",$JOB,PSI,CNT1)
- +15 if CNT1>1
- SET PREVLN=$SELECT(CNT>1:^TMP("PSO",$JOB,PSI,CNT1-1),1:"")
- +16 IF CNT1>1
- IF $$SPACE^PSOHLDS3(PREVLN,CURRLN)
- Begin DoDot:3
- +17 SET ^TMP("PSO",$JOB,PSI,CNT1)=" "_^TMP("PSO",$JOB,PSI,CNT1)
- End DoDot:3
- +18 IF J=1
- SET $PIECE(^TMP("PSO",$JOB,PSI,CNT1),":",1)="\H\"_$PIECE(^TMP("PSO",$JOB,PSI,CNT1),":",1)_"\N\"
- +19 SET CNT1=CNT1+1
- End DoDot:2
- End DoDot:1
- +20 SET ^TMP("PSO",$JOB,PSI,CNT1-1)=^TMP("PSO",$JOB,PSI,CNT1-1)_FS_"Patient Medication Instructions"
- +21 SET PSI=PSI+1
- KILL A,I,J,CNT,CNT1,^TMP($JOB,"PSNPMI")
- +22 QUIT