| [613] | 1 | PSOHLINL ;BIR/RTR-Process HL7 segments greater than 245 ;07/12/02
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**111**;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ORC ;Process multiple ORC segments
|
|---|
| 5 | S PSOHLTAG="ORCP"
|
|---|
| 6 | D PROC
|
|---|
| 7 | K PSOHLTAG
|
|---|
| 8 | Q
|
|---|
| 9 | PROC ;Process segments
|
|---|
| 10 | N PSOHPVR,PSOHPVR1,PSOHNNCK,PSOHNNN,PSOHNNNN,PSOHIII,PSOHAA,PSOHLIM,PSOHBX
|
|---|
| 11 | D RESET
|
|---|
| 12 | I $G(PSOHLTAG)="ORCP" S PSOHY("PRIOR")="R" D NOW^%DTC S PSOHY("EDT")=%
|
|---|
| 13 | S (PSOHPVR,PSOHPVR1)="",(PSOHNNCK,PSOHNNN,PSOHNNNN)=0,PSOHIII=1
|
|---|
| 14 | S PSOHAA="" F S PSOHAA=$O(PSOHBX(PSOHAA)) Q:PSOHAA="" S PSOHNNN=0 F PSOHOO=1:1:$L(PSOHBX(PSOHAA)) S PSOHNNN=PSOHNNN+1 D D:$G(PSOHPVR1)=HL("FS") @PSOHLTAG
|
|---|
| 15 | .I $E(PSOHBX(PSOHAA),PSOHOO)=HL("FS") S PSOHNNNN=PSOHNNNN+1
|
|---|
| 16 | .S PSOHPVR1=$E(PSOHBX(PSOHAA),PSOHOO)
|
|---|
| 17 | .S PSOHLIM=PSOHPVR
|
|---|
| 18 | .S PSOHPVR=$S(PSOHPVR="":PSOHPVR1,1:PSOHPVR_PSOHPVR1)
|
|---|
| 19 | I $G(PSOHPVR)'="" S PSOHLIM=PSOHPVR S PSOHNNNN=PSOHNNNN+1 D @PSOHLTAG
|
|---|
| 20 | Q
|
|---|
| 21 | ORCP ;
|
|---|
| 22 | S PSOHLMIS("ORC")=""
|
|---|
| 23 | I PSOHNNNN=1 S PSOHY("OCC")=$G(PSOHLIM) G ORCPQ
|
|---|
| 24 | I PSOHNNNN=2 S PSOHY("CHNUM")=$P(PSOHLIM,PSOHFSP) G ORCPQ
|
|---|
| 25 | I PSOHNNNN=9 S X=$G(PSOHLIM) D G ORCPQ
|
|---|
| 26 | .I X S PSOHY("SDT")=$$HL7TFM^XLFDT(X) Q
|
|---|
| 27 | .S PSOHY("SDT")=$G(PSOHY("EDT"))
|
|---|
| 28 | I PSOHNNNN=10 S PSOHY("ENTER")=+$G(PSOHLIM)
|
|---|
| 29 | I PSOHNNNN=12 S PSOHY("PROV")=+$G(PSOHLIM)
|
|---|
| 30 | ORCPQ S (PSOHPVR,PSOHLIM)=""
|
|---|
| 31 | Q
|
|---|
| 32 | RXOP ;
|
|---|
| 33 | S PSOHLMIS("RXO")=""
|
|---|
| 34 | I PSOHNNNN=10 S PSOHY("DRUG")=+$G(PSOHLIM) G RXOPQ
|
|---|
| 35 | I PSOHNNNN=11 S PSOHY("QTY")=$G(PSOHLIM) G RXOPQ
|
|---|
| 36 | I PSOHNNNN=13 S PSOHY("REF")=$G(PSOHLIM)
|
|---|
| 37 | RXOPQ S (PSOHPVR,PSOHLIM)=""
|
|---|
| 38 | Q
|
|---|
| 39 | RESET ;reset array
|
|---|
| 40 | K PSOHBX
|
|---|
| 41 | S PSOHX="" F S PSOHX=$O(PSOHB(PSOHX)) Q:PSOHX="" S PSOHBX((+$G(PSOHX)+1))=PSOHB(PSOHX)
|
|---|
| 42 | S PSOHBX(0)=PSOHB
|
|---|
| 43 | Q
|
|---|
| 44 | RXO ;Process multiple RXO segments
|
|---|
| 45 | S PSOHLTAG="RXOP"
|
|---|
| 46 | D PROC
|
|---|
| 47 | K PSOHLTAG
|
|---|
| 48 | Q
|
|---|
| 49 | COMM ;Process multiple NTE 6 (Provider comments)
|
|---|
| 50 | K ^UTILITY($J,"W")
|
|---|
| 51 | S X=$P(PSOHB,HL("FS"),3,999),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
|
|---|
| 52 | S PSOHLZ="" F S PSOHLZ=$O(PSOHB("")) Q:PSOHLZ=""!(PSOXLONG) I $G(PSOHB(PSOHLZ))'="" S X=PSOHB(PSOHLZ),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
|
|---|
| 53 | I PSOXLONG K ^UTILITY($J,"W") Q
|
|---|
| 54 | D ENCOMM
|
|---|
| 55 | K ^UTILITY($J,"W")
|
|---|
| 56 | Q
|
|---|
| 57 | SIG ;Process multiple NTE 7 (Sig)
|
|---|
| 58 | K ^UTILITY($J,"W")
|
|---|
| 59 | S X=$P(PSOHB,HL("FS"),3,999),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
|
|---|
| 60 | S PSOHLZ="" F S PSOHLZ=$O(PSOHB("")) Q:PSOHLZ=""!(PSOXLONG) I $G(PSOHB(PSOHLZ))'="" S X=PSOHB(PSOHLZ),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
|
|---|
| 61 | I PSOXLONG K ^UTILITY($J,"W") Q
|
|---|
| 62 | D ENSIG
|
|---|
| 63 | K ^UTILITY($J,"W")
|
|---|
| 64 | Q
|
|---|
| 65 | ENCOMM ;Enter provider comments into PSOHY array
|
|---|
| 66 | S PSOHLZC=1
|
|---|
| 67 | S PSOHLZ="" F S PSOHLZ=$O(^UTILITY($J,"W",1,PSOHLZ)) Q:PSOHLZ="" I $G(^(PSOHLZ,0))'="" D
|
|---|
| 68 | .S PSOHY("PRCOM",PSOHLZC)=$G(^UTILITY($J,"W",1,PSOHLZ,0)),PSOHLZC=PSOHLZC+1
|
|---|
| 69 | Q
|
|---|
| 70 | ENSIG ;Enter Sig into PSOHY array
|
|---|
| 71 | S PSOHLZC=1
|
|---|
| 72 | S PSOHLZ="" F S PSOHLZ=$O(^UTILITY($J,"W",1,PSOHLZ)) Q:PSOHLZ="" I $G(^(PSOHLZ,0))'="" D
|
|---|
| 73 | .S PSOHY("SIG",PSOHLZC)=$G(^UTILITY($J,"W",1,PSOHLZ,0)),PSOHLZC=PSOHLZC+1
|
|---|
| 74 | Q
|
|---|
| 75 | LTH ;
|
|---|
| 76 | I $L(X)>245 S PSOXLONG=1
|
|---|
| 77 | Q
|
|---|
