- PSOHLINL ;BIR/RTR-Process HL7 segments greater than 245 ;07/12/02
- ;;7.0;OUTPATIENT PHARMACY;**111**;DEC 1997
- ;
- ORC ;Process multiple ORC segments
- S PSOHLTAG="ORCP"
- D PROC
- K PSOHLTAG
- Q
- PROC ;Process segments
- N PSOHPVR,PSOHPVR1,PSOHNNCK,PSOHNNN,PSOHNNNN,PSOHIII,PSOHAA,PSOHLIM,PSOHBX
- D RESET
- I $G(PSOHLTAG)="ORCP" S PSOHY("PRIOR")="R" D NOW^%DTC S PSOHY("EDT")=%
- S (PSOHPVR,PSOHPVR1)="",(PSOHNNCK,PSOHNNN,PSOHNNNN)=0,PSOHIII=1
- 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
- .I $E(PSOHBX(PSOHAA),PSOHOO)=HL("FS") S PSOHNNNN=PSOHNNNN+1
- .S PSOHPVR1=$E(PSOHBX(PSOHAA),PSOHOO)
- .S PSOHLIM=PSOHPVR
- .S PSOHPVR=$S(PSOHPVR="":PSOHPVR1,1:PSOHPVR_PSOHPVR1)
- I $G(PSOHPVR)'="" S PSOHLIM=PSOHPVR S PSOHNNNN=PSOHNNNN+1 D @PSOHLTAG
- Q
- ORCP ;
- S PSOHLMIS("ORC")=""
- I PSOHNNNN=1 S PSOHY("OCC")=$G(PSOHLIM) G ORCPQ
- I PSOHNNNN=2 S PSOHY("CHNUM")=$P(PSOHLIM,PSOHFSP) G ORCPQ
- I PSOHNNNN=9 S X=$G(PSOHLIM) D G ORCPQ
- .I X S PSOHY("SDT")=$$HL7TFM^XLFDT(X) Q
- .S PSOHY("SDT")=$G(PSOHY("EDT"))
- I PSOHNNNN=10 S PSOHY("ENTER")=+$G(PSOHLIM)
- I PSOHNNNN=12 S PSOHY("PROV")=+$G(PSOHLIM)
- ORCPQ S (PSOHPVR,PSOHLIM)=""
- Q
- RXOP ;
- S PSOHLMIS("RXO")=""
- I PSOHNNNN=10 S PSOHY("DRUG")=+$G(PSOHLIM) G RXOPQ
- I PSOHNNNN=11 S PSOHY("QTY")=$G(PSOHLIM) G RXOPQ
- I PSOHNNNN=13 S PSOHY("REF")=$G(PSOHLIM)
- RXOPQ S (PSOHPVR,PSOHLIM)=""
- Q
- RESET ;reset array
- K PSOHBX
- S PSOHX="" F S PSOHX=$O(PSOHB(PSOHX)) Q:PSOHX="" S PSOHBX((+$G(PSOHX)+1))=PSOHB(PSOHX)
- S PSOHBX(0)=PSOHB
- Q
- RXO ;Process multiple RXO segments
- S PSOHLTAG="RXOP"
- D PROC
- K PSOHLTAG
- Q
- COMM ;Process multiple NTE 6 (Provider comments)
- K ^UTILITY($J,"W")
- S X=$P(PSOHB,HL("FS"),3,999),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
- 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
- I PSOXLONG K ^UTILITY($J,"W") Q
- D ENCOMM
- K ^UTILITY($J,"W")
- Q
- SIG ;Process multiple NTE 7 (Sig)
- K ^UTILITY($J,"W")
- S X=$P(PSOHB,HL("FS"),3,999),DIWL=1,DIWR=70,DIWF="" D LTH Q:PSOXLONG D ^DIWP
- 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
- I PSOXLONG K ^UTILITY($J,"W") Q
- D ENSIG
- K ^UTILITY($J,"W")
- Q
- ENCOMM ;Enter provider comments into PSOHY array
- S PSOHLZC=1
- S PSOHLZ="" F S PSOHLZ=$O(^UTILITY($J,"W",1,PSOHLZ)) Q:PSOHLZ="" I $G(^(PSOHLZ,0))'="" D
- .S PSOHY("PRCOM",PSOHLZC)=$G(^UTILITY($J,"W",1,PSOHLZ,0)),PSOHLZC=PSOHLZC+1
- Q
- ENSIG ;Enter Sig into PSOHY array
- S PSOHLZC=1
- S PSOHLZ="" F S PSOHLZ=$O(^UTILITY($J,"W",1,PSOHLZ)) Q:PSOHLZ="" I $G(^(PSOHLZ,0))'="" D
- .S PSOHY("SIG",PSOHLZC)=$G(^UTILITY($J,"W",1,PSOHLZ,0)),PSOHLZC=PSOHLZC+1
- Q
- LTH ;
- I $L(X)>245 S PSOXLONG=1
- Q
- PSOHLINL ;BIR/RTR-Process HL7 segments greater than 245 ;07/12/02
- +1 ;;7.0;OUTPATIENT PHARMACY;**111**;DEC 1997
- +2 ;
- ORC ;Process multiple ORC segments
- +1 SET PSOHLTAG="ORCP"
- +2 DO PROC
- +3 KILL PSOHLTAG
- +4 QUIT
- PROC ;Process segments
- +1 NEW PSOHPVR,PSOHPVR1,PSOHNNCK,PSOHNNN,PSOHNNNN,PSOHIII,PSOHAA,PSOHLIM,PSOHBX
- +2 DO RESET
- +3 IF $GET(PSOHLTAG)="ORCP"
- SET PSOHY("PRIOR")="R"
- DO NOW^%DTC
- SET PSOHY("EDT")=%
- +4 SET (PSOHPVR,PSOHPVR1)=""
- SET (PSOHNNCK,PSOHNNN,PSOHNNNN)=0
- SET PSOHIII=1
- +5 SET PSOHAA=""
- FOR
- SET PSOHAA=$ORDER(PSOHBX(PSOHAA))
- IF PSOHAA=""
- QUIT
- SET PSOHNNN=0
- FOR PSOHOO=1:1:$LENGTH(PSOHBX(PSOHAA))
- SET PSOHNNN=PSOHNNN+1
- Begin DoDot:1
- +6 IF $EXTRACT(PSOHBX(PSOHAA),PSOHOO)=HL("FS")
- SET PSOHNNNN=PSOHNNNN+1
- +7 SET PSOHPVR1=$EXTRACT(PSOHBX(PSOHAA),PSOHOO)
- +8 SET PSOHLIM=PSOHPVR
- +9 SET PSOHPVR=$SELECT(PSOHPVR="":PSOHPVR1,1:PSOHPVR_PSOHPVR1)
- End DoDot:1
- IF $GET(PSOHPVR1)=HL("FS")
- DO @PSOHLTAG
- +10 IF $GET(PSOHPVR)'=""
- SET PSOHLIM=PSOHPVR
- SET PSOHNNNN=PSOHNNNN+1
- DO @PSOHLTAG
- +11 QUIT
- ORCP ;
- +1 SET PSOHLMIS("ORC")=""
- +2 IF PSOHNNNN=1
- SET PSOHY("OCC")=$GET(PSOHLIM)
- GOTO ORCPQ
- +3 IF PSOHNNNN=2
- SET PSOHY("CHNUM")=$PIECE(PSOHLIM,PSOHFSP)
- GOTO ORCPQ
- +4 IF PSOHNNNN=9
- SET X=$GET(PSOHLIM)
- Begin DoDot:1
- +5 IF X
- SET PSOHY("SDT")=$$HL7TFM^XLFDT(X)
- QUIT
- +6 SET PSOHY("SDT")=$GET(PSOHY("EDT"))
- End DoDot:1
- GOTO ORCPQ
- +7 IF PSOHNNNN=10
- SET PSOHY("ENTER")=+$GET(PSOHLIM)
- +8 IF PSOHNNNN=12
- SET PSOHY("PROV")=+$GET(PSOHLIM)
- ORCPQ SET (PSOHPVR,PSOHLIM)=""
- +1 QUIT
- RXOP ;
- +1 SET PSOHLMIS("RXO")=""
- +2 IF PSOHNNNN=10
- SET PSOHY("DRUG")=+$GET(PSOHLIM)
- GOTO RXOPQ
- +3 IF PSOHNNNN=11
- SET PSOHY("QTY")=$GET(PSOHLIM)
- GOTO RXOPQ
- +4 IF PSOHNNNN=13
- SET PSOHY("REF")=$GET(PSOHLIM)
- RXOPQ SET (PSOHPVR,PSOHLIM)=""
- +1 QUIT
- RESET ;reset array
- +1 KILL PSOHBX
- +2 SET PSOHX=""
- FOR
- SET PSOHX=$ORDER(PSOHB(PSOHX))
- IF PSOHX=""
- QUIT
- SET PSOHBX((+$GET(PSOHX)+1))=PSOHB(PSOHX)
- +3 SET PSOHBX(0)=PSOHB
- +4 QUIT
- RXO ;Process multiple RXO segments
- +1 SET PSOHLTAG="RXOP"
- +2 DO PROC
- +3 KILL PSOHLTAG
- +4 QUIT
- COMM ;Process multiple NTE 6 (Provider comments)
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET X=$PIECE(PSOHB,HL("FS"),3,999)
- SET DIWL=1
- SET DIWR=70
- SET DIWF=""
- DO LTH
- IF PSOXLONG
- QUIT
- DO ^DIWP
- +3 SET PSOHLZ=""
- FOR
- SET PSOHLZ=$ORDER(PSOHB(""))
- IF PSOHLZ=""!(PSOXLONG)
- QUIT
- IF $GET(PSOHB(PSOHLZ))'=""
- SET X=PSOHB(PSOHLZ)
- SET DIWL=1
- SET DIWR=70
- SET DIWF=""
- DO LTH
- IF PSOXLONG
- QUIT
- DO ^DIWP
- +4 IF PSOXLONG
- KILL ^UTILITY($JOB,"W")
- QUIT
- +5 DO ENCOMM
- +6 KILL ^UTILITY($JOB,"W")
- +7 QUIT
- SIG ;Process multiple NTE 7 (Sig)
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET X=$PIECE(PSOHB,HL("FS"),3,999)
- SET DIWL=1
- SET DIWR=70
- SET DIWF=""
- DO LTH
- IF PSOXLONG
- QUIT
- DO ^DIWP
- +3 SET PSOHLZ=""
- FOR
- SET PSOHLZ=$ORDER(PSOHB(""))
- IF PSOHLZ=""!(PSOXLONG)
- QUIT
- IF $GET(PSOHB(PSOHLZ))'=""
- SET X=PSOHB(PSOHLZ)
- SET DIWL=1
- SET DIWR=70
- SET DIWF=""
- DO LTH
- IF PSOXLONG
- QUIT
- DO ^DIWP
- +4 IF PSOXLONG
- KILL ^UTILITY($JOB,"W")
- QUIT
- +5 DO ENSIG
- +6 KILL ^UTILITY($JOB,"W")
- +7 QUIT
- ENCOMM ;Enter provider comments into PSOHY array
- +1 SET PSOHLZC=1
- +2 SET PSOHLZ=""
- FOR
- SET PSOHLZ=$ORDER(^UTILITY($JOB,"W",1,PSOHLZ))
- IF PSOHLZ=""
- QUIT
- IF $GET(^(PSOHLZ,0))'=""
- Begin DoDot:1
- +3 SET PSOHY("PRCOM",PSOHLZC)=$GET(^UTILITY($JOB,"W",1,PSOHLZ,0))
- SET PSOHLZC=PSOHLZC+1
- End DoDot:1
- +4 QUIT
- ENSIG ;Enter Sig into PSOHY array
- +1 SET PSOHLZC=1
- +2 SET PSOHLZ=""
- FOR
- SET PSOHLZ=$ORDER(^UTILITY($JOB,"W",1,PSOHLZ))
- IF PSOHLZ=""
- QUIT
- IF $GET(^(PSOHLZ,0))'=""
- Begin DoDot:1
- +3 SET PSOHY("SIG",PSOHLZC)=$GET(^UTILITY($JOB,"W",1,PSOHLZ,0))
- SET PSOHLZC=PSOHLZC+1
- End DoDot:1
- +4 QUIT
- LTH ;
- +1 IF $LENGTH(X)>245
- SET PSOXLONG=1
- +2 QUIT
