Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOHLINC

PSOHLINC.m

Go to the documentation of this file.
  1. PSOHLINC ;BIR/RTR - Process incoming order messages from CHCS ;06/17/02
  1. ;;7.0;OUTPATIENT PHARMACY;**111,143**;DEC 1997
  1. ;
  1. EN ;Process incoming outpatient order messages
  1. N PSOXLONG,PSOHDFOR,PSOHLTAG,PSOHBDS,PSOHMSG,PSOHLMIS,PSOHLRS,PSOHEID,PSOHEIDS,PSOHFSP,PSOHLNOP,PSOXHI,PSOHLZ,PSOHLZC,PSOHLRXO,PSOXMH,PSOHY,PSOEXMS,PSOEXXQ,PSOHG,PSOBH,X,Y
  1. I '$G(DT) S DT=$$DT^XLFDT
  1. S (PSOXLONG,PSOHLRXO,PSOHLNOP,PSOHDFOR)=0
  1. S PSOHFSP=$E(HL("ECH"),1)
  1. K PSOHLMIS
  1. F PSOXHI=1:1 K PSOHB X HLNEXT Q:HLQUIT'>0!(PSOHLNOP)!(PSOHDFOR)!(PSOXLONG) S PSOHB=HLNODE,PSOXMH=$E(PSOHB,1,3) D
  1. .S PSOHG=0 F S PSOHG=$O(HLNODE(PSOHG)) Q:'PSOHG!(PSOHLNOP)!(PSOHDFOR)!(PSOXLONG) S PSOHB(PSOHG)=HLNODE(PSOHG)
  1. .I (PSOXMH'?3U),(PSOXMH'?2U1N) S PSOHDFOR=1 Q
  1. .I $T(@PSOXMH)]"" D @PSOXMH
  1. ;Quit if not a Pharmacy message, no acknowledgements
  1. I $G(PSOHLNOP) Q
  1. I $G(PSOHY("OCC"))="CA" D ENDC^PSOHLDC Q
  1. I PSOXLONG S PSOEXMS="Invalid NTE segment, greater than 245 characters." D NAK^PSOHLEXC Q
  1. S (PSOHBDS,PSOEXXQ)=0
  1. I PSOHDFOR S PSOEXMS="Invalid message structure." D NAK^PSOHLEXC Q
  1. F PSOHMSG="MSH","PID","PV1","ORC","RXO" Q:PSOEXXQ I '$D(PSOHLMIS(PSOHMSG)) S PSOEXMS="Missing "_PSOHMSG_" segment." S PSOHBDS=1 D NAK^PSOHLEXC
  1. ;Quit if segment is missing
  1. I $G(PSOEXXQ) Q
  1. ;Quit if not a Pharmacy message, no acknowledgements
  1. ;I $G(PSOHLNOP) Q
  1. ;check for data exceptions
  1. D CHECK^PSOHLEXC
  1. ;PSOEXXQ set if a NAK was sent back
  1. I $G(PSOEXXQ) Q
  1. ;Enter order into Pending Outpatient Orders file
  1. D ADD^PSOHCPRS
  1. ;Send successful acknowledgement if PSOEXXQ not set
  1. I '$G(PSOEXXQ) D ACK^PSOHLEXC
  1. Q
  1. ;What about regular acknowledgements? handled by HL7 package somehow
  1. Q
  1. MSH ;Process MSH segment
  1. I $P(PSOHB,HL("FS"),5)'="PSO RECEIVE" S PSOHLNOP=1
  1. S PSOHLMIS("MSH")=""
  1. Q
  1. PID ;Process PID segment
  1. D FORM
  1. S PSOHY("PAT")=+$P(PSOHB,HL("FS"),3)
  1. S PSOHLMIS("PID")=""
  1. Q
  1. PV1 ;Process PV1 segment
  1. D FORM
  1. S PSOHY("LOC")=+$P(PSOHB,HL("FS"),3)
  1. S PSOHLMIS("PV1")=""
  1. Q
  1. DG1 ;Process DG1 segment ; future use
  1. D FORM
  1. S $P(PSOHY("ICD"),U,$P(PSOHB,HL("FS"),1))=$P(PSOHB,HL("FS"),3)
  1. ZCL Q ;future use
  1. ;
  1. ORC ;Process ORC segment
  1. S PSOHLRXO=1 ;For future use in processing NTE's, if other segments get NTE(6) or (7)
  1. D FORM
  1. I $O(PSOHB(""))'="" D ORC^PSOHLINL Q
  1. S PSOHY("OCC")=$P(PSOHB,HL("FS"))
  1. ;Set priority to Routine
  1. S PSOHY("PRIOR")="R"
  1. S PSOHY("CHNUM")=$P($P(PSOHB,HL("FS"),2),PSOHFSP)
  1. D NOW^%DTC S PSOHY("EDT")=%
  1. S X=$P(PSOHB,HL("FS"),9) D
  1. .I X S PSOHY("SDT")=$$HL7TFM^XLFDT(X) Q
  1. .S PSOHY("SDT")=$G(PSOHY("EDT"))
  1. S PSOHY("ENTER")=+$P(PSOHB,HL("FS"),10)
  1. S PSOHY("PROV")=+$P(PSOHB,HL("FS"),12)
  1. S PSOHLMIS("ORC")=""
  1. Q
  1. RXO ;Process RXO segment
  1. D FORM
  1. I $O(PSOHB(""))'="" D RXO^PSOHLINL Q
  1. S PSOHY("DRUG")=+$P(PSOHB,HL("FS"),10)
  1. S PSOHY("QTY")=$P(PSOHB,HL("FS"),11)
  1. S PSOHY("REF")=$P(PSOHB,HL("FS"),13)
  1. S PSOHLMIS("RXO")=""
  1. Q
  1. RXR ;Process RXR segment
  1. D FORM
  1. Q
  1. ZRX ;Process ZRX segment
  1. D FORM
  1. S PSOHY("PICK")=$S($P(PSOHB,HL("FS"),4)="M":"M",1:"W")
  1. Q
  1. NTE ;
  1. D FORM
  1. I $P(PSOHB,HL("FS"))=6 D COMM Q
  1. I $P(PSOHB,HL("FS"))=7 D SIG Q
  1. Q
  1. COMM ;Process Provider Comments
  1. I $O(PSOHB(""))'="" D COMM^PSOHLINL Q
  1. K ^UTILITY($J,"W")
  1. S X=$P(PSOHB,HL("FS"),3,999)
  1. I $L(X)>245 S PSOXLONG=1 Q
  1. S DIWL=1,DIWR=70,DIWF="" D ^DIWP
  1. D ENCOMM^PSOHLINL
  1. K ^UTILITY($J,"W")
  1. Q
  1. SIG ;Process SIG
  1. I $O(PSOHB(""))'="" D SIG^PSOHLINL Q
  1. K ^UTILITY($J,"W")
  1. S X=$P(PSOHB,HL("FS"),3,999)
  1. I $L(X)>245 S PSOXLONG=1 Q
  1. S DIWL=1,DIWR=70,DIWF="" D ^DIWP
  1. D ENSIG^PSOHLINL
  1. K ^UTILITY($J,"W")
  1. Q
  1. FORM ;
  1. S PSOHB=$E(PSOHB,(4+$L(HL("FS"))),$L(PSOHB))
  1. Q
  1. ;AND IF YOU ADD PSOHLNEW TO THE PATCH, FIX THE HEADER OF THE 3 NODE TO MATCH HOW YOU DID IT IN PSOHCPRS. SINCE IT IS A WORD PROCESSING FIELD
  1. ; And maybe fix -1 problem if no related institution is found
  1. ; AND IF YOU PATCH PSOHLSN1, AT THE rxr POINT, INITIALIZE RTENAME AT THE BEGINNING OF EACH LOOP