- PSORDS ;BHAM ISC/LC - BUILD RDS MESSAGE ; 02/22/95
- ;;7.0;OUTPATIENT PHARMACY;**11**;DEC 1997
- ;
- ;^UTILITY($J,"PSOPCE",COUNTER)= 6 pieces, which are:
- ; Piece one -> Internal Rx number
- ; Piece two -> Quantity
- ; Piece three -> File 50 pointer
- ; Piece four -> 1 for Release 0 for Return to stock
- ; Piece five -> 0 for original, 1 for refill, 2 for partial
- ; Piece six -> Date/Time or Date
- ;
- MSG ;
- F PSOAAA=0:0 S PSOAAA=$O(^UTILITY($J,"PSOPCE",PSOAAA)) Q:'PSOAAA S PCENODE=^(PSOAAA) D SEND
- G END
- SEND ;
- K MSG S RXP=+$P(PCENODE,"^"),RXDRUG=+$P(PCENODE,"^",3),PSORE=$P(PCENODE,"^",4),PSOFILL=$P(PCENODE,"^",5),PSODTIME=$P(PCENODE,"^",6)
- Q:'$D(^PSRX(RXP,0))!('RXP)
- S PSORXEXT=$P($G(^PSRX(RXP,0)),"^"),PSFLAG=0,PSORINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^"),NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)="""""
- S LIMIT=15 X NULLFLDS K X
- S X=PSODTIME S:'X X=DT S FIELD(3)=$$HLDATE^HLFNC(X)
- S PSND1=$P($G(^PSDRUG(RXDRUG,"ND")),"^"),PSND2=$P($G(^("ND")),"^",2),PSND3=$P($G(^("ND")),"^",3) I PSND1,PSND3 S PSFLAG=1
- S FIELD(2)=$S(PSFLAG:PSND1_"."_PSND3_"^"_PSND2_"^"_"99NDF",1:"^^")_"^"_RXDRUG_"^"_$P($G(^PSDRUG(RXDRUG,0)),"^")_"^"_"99PSD"
- S FIELD(4)=$P(PCENODE,"^",2)
- S FIELD(7)=$P(^PSRX(RXP,0),"^")
- S FIELD(9)=$S(PSORE=0&(PSOFILL=2):"PARTIAL RETURN TO STOCK",PSORE=0:"RETURN TO STOCK",PSOFILL=2:"PARTIAL RELEASE",1:"RELEASE")
- S POIPTR=+$P($G(^PSRX(RXP,"OR1")),"^") I POIPTR S PODOSE=+$P($G(^PS(50.7,POIPTR,0)),"^",2),PODOSENM=$P($G(^PS(50.606,PODOSE,0)),"^")
- S FIELD(6)=$S(POIPTR:"^^^"_$G(PODOSE)_"^"_$G(PODOSENM)_"^"_"99PSF",1:"")
- S MSG(1)="MSH|^~\&|PHARMACY|"_PSORINST_"|||||RDS"
- S MSG(2)="PID|||"_$P(^PSRX(RXP,0),"^",2)_"||"_$P($G(^DPT(+$P($G(^(0)),"^",2),0)),"^")
- S MSG(3)="ORC|OR||"_$G(RXP)
- K FSIG,BSIG I $P($G(^PSRX(RXP,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXP,245) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
- K FSIG,PSREV I '$P($G(^PSRX(RXP,"SIG")),"^",2) D EN3^PSOUTLA1(RXP,245)
- S FIELD(15)=$G(BSIG(1))
- S FIELD(0)="RXD",COUNT=3 D SEGPAR^PSOHLSN K COUNT,PVAR,PLIM,PVAR1,FIELD,SUBCOUNT,SEG1
- K LSIG I $O(BSIG(1)) D
- .S LASTSIG=$O(BSIG(1)) S LSIG=$G(BSIG(LASTSIG))
- I $G(LSIG)'="",$O(MSG(4,0)) D
- .N LAST S LAST=0 F ZZZ=0:0 S ZZZ=$O(MSG(4,ZZZ)) Q:'ZZZ S LAST=ZZZ
- .S LTH=$L(MSG(4,LAST)) S LTH=245-LTH
- .I LTH S MSG(4,LAST)=MSG(4,LAST)_$E(LSIG,1,LTH) S LTH=LTH+1,LSIG=$E(LSIG,LTH,245)
- .S LAST=LAST+1 S:$G(LSIG)'="" MSG(4,LAST)=$G(LSIG)
- ;D MSG^XQOR("PS EVSEND OR",.MSG)
- Q
- END K ^UTILITY($J,"PSOPCE"),BSIG,COUNT,FIELD,FSIG,JJ,LAST,LASTSIG,LIMIT,LTH,MSG,NULLFLDS,PODOSE,PODOSENM,POIPTR,PSFLAG,PSND1,PSND2,PSND3,PSORINST,PSORXEXT,RXP,PSREV,RXDRUG,ZZZ,PSORE,PSOFILL,PSOAAA,PCENODE S ZTREQ="@" Q
- PSORDS ;BHAM ISC/LC - BUILD RDS MESSAGE ; 02/22/95
- +1 ;;7.0;OUTPATIENT PHARMACY;**11**;DEC 1997
- +2 ;
- +3 ;^UTILITY($J,"PSOPCE",COUNTER)= 6 pieces, which are:
- +4 ; Piece one -> Internal Rx number
- +5 ; Piece two -> Quantity
- +6 ; Piece three -> File 50 pointer
- +7 ; Piece four -> 1 for Release 0 for Return to stock
- +8 ; Piece five -> 0 for original, 1 for refill, 2 for partial
- +9 ; Piece six -> Date/Time or Date
- +10 ;
- MSG ;
- +1 FOR PSOAAA=0:0
- SET PSOAAA=$ORDER(^UTILITY($JOB,"PSOPCE",PSOAAA))
- IF 'PSOAAA
- QUIT
- SET PCENODE=^(PSOAAA)
- DO SEND
- +2 GOTO END
- SEND ;
- +1 KILL MSG
- SET RXP=+$PIECE(PCENODE,"^")
- SET RXDRUG=+$PIECE(PCENODE,"^",3)
- SET PSORE=$PIECE(PCENODE,"^",4)
- SET PSOFILL=$PIECE(PCENODE,"^",5)
- SET PSODTIME=$PIECE(PCENODE,"^",6)
- +2 IF '$DATA(^PSRX(RXP,0))!('RXP)
- QUIT
- +3 SET PSORXEXT=$PIECE($GET(^PSRX(RXP,0)),"^")
- SET PSFLAG=0
- SET PSORINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
- SET NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)="""""
- +4 SET LIMIT=15
- XECUTE NULLFLDS
- KILL X
- +5 SET X=PSODTIME
- IF 'X
- SET X=DT
- SET FIELD(3)=$$HLDATE^HLFNC(X)
- +6 SET PSND1=$PIECE($GET(^PSDRUG(RXDRUG,"ND")),"^")
- SET PSND2=$PIECE($GET(^("ND")),"^",2)
- SET PSND3=$PIECE($GET(^("ND")),"^",3)
- IF PSND1
- IF PSND3
- SET PSFLAG=1
- +7 SET FIELD(2)=$SELECT(PSFLAG:PSND1_"."_PSND3_"^"_PSND2_"^"_"99NDF",1:"^^")_"^"_RXDRUG_"^"_$PIECE($GET(^PSDRUG(RXDRUG,0)),"^")_"^"_"99PSD"
- +8 SET FIELD(4)=$PIECE(PCENODE,"^",2)
- +9 SET FIELD(7)=$PIECE(^PSRX(RXP,0),"^")
- +10 SET FIELD(9)=$SELECT(PSORE=0&(PSOFILL=2):"PARTIAL RETURN TO STOCK",PSORE=0:"RETURN TO STOCK",PSOFILL=2:"PARTIAL RELEASE",1:"RELEASE")
- +11 SET POIPTR=+$PIECE($GET(^PSRX(RXP,"OR1")),"^")
- IF POIPTR
- SET PODOSE=+$PIECE($GET(^PS(50.7,POIPTR,0)),"^",2)
- SET PODOSENM=$PIECE($GET(^PS(50.606,PODOSE,0)),"^")
- +12 SET FIELD(6)=$SELECT(POIPTR:"^^^"_$GET(PODOSE)_"^"_$GET(PODOSENM)_"^"_"99PSF",1:"")
- +13 SET MSG(1)="MSH|^~\&|PHARMACY|"_PSORINST_"|||||RDS"
- +14 SET MSG(2)="PID|||"_$PIECE(^PSRX(RXP,0),"^",2)_"||"_$PIECE($GET(^DPT(+$PIECE($GET(^(0)),"^",2),0)),"^")
- +15 SET MSG(3)="ORC|OR||"_$GET(RXP)
- +16 KILL FSIG,BSIG
- IF $PIECE($GET(^PSRX(RXP,"SIG")),"^",2)
- DO FSIG^PSOUTLA("R",RXP,245)
- FOR PSREV=1:1
- IF '$DATA(FSIG(PSREV))
- QUIT
- SET BSIG(PSREV)=FSIG(PSREV)
- +17 KILL FSIG,PSREV
- IF '$PIECE($GET(^PSRX(RXP,"SIG")),"^",2)
- DO EN3^PSOUTLA1(RXP,245)
- +18 SET FIELD(15)=$GET(BSIG(1))
- +19 SET FIELD(0)="RXD"
- SET COUNT=3
- DO SEGPAR^PSOHLSN
- KILL COUNT,PVAR,PLIM,PVAR1,FIELD,SUBCOUNT,SEG1
- +20 KILL LSIG
- IF $ORDER(BSIG(1))
- Begin DoDot:1
- +21 SET LASTSIG=$ORDER(BSIG(1))
- SET LSIG=$GET(BSIG(LASTSIG))
- End DoDot:1
- +22 IF $GET(LSIG)'=""
- IF $ORDER(MSG(4,0))
- Begin DoDot:1
- +23 NEW LAST
- SET LAST=0
- FOR ZZZ=0:0
- SET ZZZ=$ORDER(MSG(4,ZZZ))
- IF 'ZZZ
- QUIT
- SET LAST=ZZZ
- +24 SET LTH=$LENGTH(MSG(4,LAST))
- SET LTH=245-LTH
- +25 IF LTH
- SET MSG(4,LAST)=MSG(4,LAST)_$EXTRACT(LSIG,1,LTH)
- SET LTH=LTH+1
- SET LSIG=$EXTRACT(LSIG,LTH,245)
- +26 SET LAST=LAST+1
- IF $GET(LSIG)'=""
- SET MSG(4,LAST)=$GET(LSIG)
- End DoDot:1
- +27 ;D MSG^XQOR("PS EVSEND OR",.MSG)
- +28 QUIT
- END KILL ^UTILITY($JOB,"PSOPCE"),BSIG,COUNT,FIELD,FSIG,JJ,LAST,LASTSIG,LIMIT,LTH,MSG,NULLFLDS,PODOSE,PODOSENM,POIPTR,PSFLAG,PSND1,PSND2,PSND3,PSORINST,PSORXEXT,RXP,PSREV,RXDRUG,ZZZ,PSORE,PSOFILL,PSOAAA,PCENODE
- SET ZTREQ="@"
- QUIT
