- PSOHLEXC ;BIR/RTR-Process exceptions in HL7 message ;07/01/02
- ;;7.0;OUTPATIENT PHARMACY;**111**;DEC 1997
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^VA(200 supported by DBIA 224
- ;
- ;Don't worry about ICN, just get it when you build message
- CHECK ;Check for application acknowledgement exceptions
- I $G(HL("SAN"))="" S PSOEXMS="Missing sending application name." D NAK Q
- S PSOHY("EXAPP")=HL("SAN")
- I '$G(PSOHY("PAT"))!('$D(^DPT(+$G(PSOHY("PAT")),0))) S PSOEXMS="Invalid patient entry." D NAK Q
- I +$P($G(^DPT(PSOHY("PAT"),.35)),"^") S PSOEXMS="Patient is deceased." D NAK Q
- I $G(PSOHY("OCC"))'="NW" S PSOEXMS="Invalid Order Control Code." D NAK Q
- I '$G(PSOHY("LOC")) S PSOEXMS="No Patient Location." D NAK Q
- I $G(PSOHY("CHNUM"))="" S PSOEXMS="Missing CHCS Placer Order Number." D NAK Q
- I $D(^PS(52.41,"C",PSOHY("CHNUM"),PSOHY("EXAPP"))) S PSOEXMS="Duplicate order number in Outpatient Pending file." D NAK Q
- I $D(^PSRX("D",PSOHY("CHNUM"),PSOHY("EXAPP"))) S PSOEXMS="Duplicate order number in Outpatient Prescription file." D NAK Q
- I $G(PSOHY("REF"))="" S PSOEXMS="Missing number of refills." D NAK Q
- I $G(PSOHY("SDT"))="" S PSOEXMS="Missing effective date." D NAK Q
- I '$G(PSOHY("ENTER")) S PSOEXMS="Missing Entered by data." D NAK Q
- ;Drug exceptions
- I '$G(PSOHY("DRUG"))!('$D(^PSDRUG(+$G(PSOHY("DRUG")),0))) S PSOEXMS="Invalid drug entry." D NAK Q
- I $P($G(^PSDRUG(PSOHY("DRUG"),2)),"^",3)'["O" S PSOEXMS="Drug not marked for outpatient use." D NAK Q
- I $P($G(^PSDRUG(PSOHY("DRUG"),"I")),"^"),$P($G(^("I")),"^")<DT S PSOEXMS="Drug is inactive." D NAK Q
- I '$P($G(^PSDRUG(PSOHY("DRUG"),2)),"^") S PSOEXMS="Drug not associated with a Pharmacy Orderable Item." D NAK Q
- S PSOHY("ITEM")=$P($G(^PSDRUG(PSOHY("DRUG"),2)),"^")
- ;Provider exceptions
- CAN ;Also doing provider exceptions on the cancel message
- I '$G(PSOHY("PROV")) S PSOEXMS="Invalid provider entry." D NAK Q
- I '$P($G(^VA(200,PSOHY("PROV"),"PS")),"^") S PSOEXMS="Provider is not authorized to write med orders." D NAK Q
- I '$D(^XUSEC("PROVIDER",PSOHY("PROV"))) S PSOEXMS="Provider does not hold the PROVIDER key." D NAK Q
- N DA,DIC,DIQ,DR,X,Y
- K ^UTILITY("DIQ1",$J) S DIC=200,DR="9.2;53.4",DA=PSOHY("PROV"),DIQ(0)="I" D EN^DIQ1
- I $G(^UTILITY("DIQ1",$J,200,PSOHY("PROV"),9.2,"I")),$P($G(^("I")),"^")'>DT S PSOEXMS="Provider has a termination date." D NAK G END
- I $G(^UTILITY("DIQ1",$J,200,PSOHY("PROV"),53.4,"I")),$P($G(^("I")),"^")'>DT S PSOEXMS="Provider has an inactive date." D NAK
- END K ^UTILITY("DIQ1",$J)
- Q
- Q
- ACK ;Send a positive acknowledgement of the order
- I $G(HL("APAT"))'="AL" Q
- K PSOEXMS
- D MSH
- S ^TMP("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_$G(HL("MID"))_HL("FS")_$G(PSOEXMS)
- D SEND
- Q
- NAK ;Send a negative acknowledgement of the order
- S PSOEXXQ=1
- I $G(HL("APAT"))'="AL" Q
- D MSH
- ;S ^TMP("HLA",$J,1)="MSA"_HL("FS")_$S($G(PSOHBDS):"AR",1:"AE")_HL("FS")_$G(HL("MID"))_HL("FS")_$G(PSOEXMS)
- ;For now, always sending back the AA, not the AR or AE
- S ^TMP("HLA",$J,1)="MSA"_HL("FS")_"AA"_HL("FS")_$G(HL("MID"))_HL("FS")_$G(PSOEXMS)
- ;Sending AR back for missing segments, AE for other data validations
- D SEND
- Q
- MSH ;
- K ^TMP("HLA",$J)
- S PSOHEID=$G(HL("EID")),PSOHEIDS=$G(HL("EIDS"))
- S PSOHLRS=""
- ;Vista HL7 will build the MSH
- Q
- SEND ;
- D GENACK^HLMA1(PSOHEID,HLMTIENS,PSOHEIDS,"GM",1,.PSOHLRS)
- K ^TMP("HLA",$J)
- Q
- PSOHLEXC ;BIR/RTR-Process exceptions in HL7 message ;07/01/02
- +1 ;;7.0;OUTPATIENT PHARMACY;**111**;DEC 1997
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External reference to ^VA(200 supported by DBIA 224
- +4 ;
- +5 ;Don't worry about ICN, just get it when you build message
- CHECK ;Check for application acknowledgement exceptions
- +1 IF $GET(HL("SAN"))=""
- SET PSOEXMS="Missing sending application name."
- DO NAK
- QUIT
- +2 SET PSOHY("EXAPP")=HL("SAN")
- +3 IF '$GET(PSOHY("PAT"))!('$DATA(^DPT(+$GET(PSOHY("PAT")),0)))
- SET PSOEXMS="Invalid patient entry."
- DO NAK
- QUIT
- +4 IF +$PIECE($GET(^DPT(PSOHY("PAT"),.35)),"^")
- SET PSOEXMS="Patient is deceased."
- DO NAK
- QUIT
- +5 IF $GET(PSOHY("OCC"))'="NW"
- SET PSOEXMS="Invalid Order Control Code."
- DO NAK
- QUIT
- +6 IF '$GET(PSOHY("LOC"))
- SET PSOEXMS="No Patient Location."
- DO NAK
- QUIT
- +7 IF $GET(PSOHY("CHNUM"))=""
- SET PSOEXMS="Missing CHCS Placer Order Number."
- DO NAK
- QUIT
- +8 IF $DATA(^PS(52.41,"C",PSOHY("CHNUM"),PSOHY("EXAPP")))
- SET PSOEXMS="Duplicate order number in Outpatient Pending file."
- DO NAK
- QUIT
- +9 IF $DATA(^PSRX("D",PSOHY("CHNUM"),PSOHY("EXAPP")))
- SET PSOEXMS="Duplicate order number in Outpatient Prescription file."
- DO NAK
- QUIT
- +10 IF $GET(PSOHY("REF"))=""
- SET PSOEXMS="Missing number of refills."
- DO NAK
- QUIT
- +11 IF $GET(PSOHY("SDT"))=""
- SET PSOEXMS="Missing effective date."
- DO NAK
- QUIT
- +12 IF '$GET(PSOHY("ENTER"))
- SET PSOEXMS="Missing Entered by data."
- DO NAK
- QUIT
- +13 ;Drug exceptions
- +14 IF '$GET(PSOHY("DRUG"))!('$DATA(^PSDRUG(+$GET(PSOHY("DRUG")),0)))
- SET PSOEXMS="Invalid drug entry."
- DO NAK
- QUIT
- +15 IF $PIECE($GET(^PSDRUG(PSOHY("DRUG"),2)),"^",3)'["O"
- SET PSOEXMS="Drug not marked for outpatient use."
- DO NAK
- QUIT
- +16 IF $PIECE($GET(^PSDRUG(PSOHY("DRUG"),"I")),"^")
- IF $PIECE($GET(^("I")),"^")<DT
- SET PSOEXMS="Drug is inactive."
- DO NAK
- QUIT
- +17 IF '$PIECE($GET(^PSDRUG(PSOHY("DRUG"),2)),"^")
- SET PSOEXMS="Drug not associated with a Pharmacy Orderable Item."
- DO NAK
- QUIT
- +18 SET PSOHY("ITEM")=$PIECE($GET(^PSDRUG(PSOHY("DRUG"),2)),"^")
- +19 ;Provider exceptions
- CAN ;Also doing provider exceptions on the cancel message
- +1 IF '$GET(PSOHY("PROV"))
- SET PSOEXMS="Invalid provider entry."
- DO NAK
- QUIT
- +2 IF '$PIECE($GET(^VA(200,PSOHY("PROV"),"PS")),"^")
- SET PSOEXMS="Provider is not authorized to write med orders."
- DO NAK
- QUIT
- +3 IF '$DATA(^XUSEC("PROVIDER",PSOHY("PROV")))
- SET PSOEXMS="Provider does not hold the PROVIDER key."
- DO NAK
- QUIT
- +4 NEW DA,DIC,DIQ,DR,X,Y
- +5 KILL ^UTILITY("DIQ1",$JOB)
- SET DIC=200
- SET DR="9.2;53.4"
- SET DA=PSOHY("PROV")
- SET DIQ(0)="I"
- DO EN^DIQ1
- +6 IF $GET(^UTILITY("DIQ1",$JOB,200,PSOHY("PROV"),9.2,"I"))
- IF $PIECE($GET(^("I")),"^")'>DT
- SET PSOEXMS="Provider has a termination date."
- DO NAK
- GOTO END
- +7 IF $GET(^UTILITY("DIQ1",$JOB,200,PSOHY("PROV"),53.4,"I"))
- IF $PIECE($GET(^("I")),"^")'>DT
- SET PSOEXMS="Provider has an inactive date."
- DO NAK
- END KILL ^UTILITY("DIQ1",$JOB)
- +1 QUIT
- +2 QUIT
- ACK ;Send a positive acknowledgement of the order
- +1 IF $GET(HL("APAT"))'="AL"
- QUIT
- +2 KILL PSOEXMS
- +3 DO MSH
- +4 SET ^TMP("HLA",$JOB,1)="MSA"_HL("FS")_"AA"_HL("FS")_$GET(HL("MID"))_HL("FS")_$GET(PSOEXMS)
- +5 DO SEND
- +6 QUIT
- NAK ;Send a negative acknowledgement of the order
- +1 SET PSOEXXQ=1
- +2 IF $GET(HL("APAT"))'="AL"
- QUIT
- +3 DO MSH
- +4 ;S ^TMP("HLA",$J,1)="MSA"_HL("FS")_$S($G(PSOHBDS):"AR",1:"AE")_HL("FS")_$G(HL("MID"))_HL("FS")_$G(PSOEXMS)
- +5 ;For now, always sending back the AA, not the AR or AE
- +6 SET ^TMP("HLA",$JOB,1)="MSA"_HL("FS")_"AA"_HL("FS")_$GET(HL("MID"))_HL("FS")_$GET(PSOEXMS)
- +7 ;Sending AR back for missing segments, AE for other data validations
- +8 DO SEND
- +9 QUIT
- MSH ;
- +1 KILL ^TMP("HLA",$JOB)
- +2 SET PSOHEID=$GET(HL("EID"))
- SET PSOHEIDS=$GET(HL("EIDS"))
- +3 SET PSOHLRS=""
- +4 ;Vista HL7 will build the MSH
- +5 QUIT
- SEND ;
- +1 DO GENACK^HLMA1(PSOHEID,HLMTIENS,PSOHEIDS,"GM",1,.PSOHLRS)
- +2 KILL ^TMP("HLA",$JOB)
- +3 QUIT
