- PSOHLDS6 ;BIR/MV - Update Host site for a OneVA fill ; 8/30/21 3:21pm
- ;;7.0;OUTPATIENT PHARMACY;**643,736**;DEC 1997;Build 19
- ;
- HOST ;Update dispensing information at the host site for a OneVa OPAI fill, p736 - handle possible HLNODE overflow nodes
- N PSOHAIL,PSOHSUB,PSOHORC,PSOHRXD,PSOMSG,J,PSOHIEN,PSOHIENR,PSOHFILL,PSOHCHEK,PSOS5209,PSOHTPE,PSOHFLOT,PSOHSEXP,PSOHSMAN,PSOHSNDC,PSOHNTE,PSOHSUBR
- N ORC K PSOMSG F PSOHAIL=1:1 X HLNEXT Q:HLQUIT'>0 S PSOMSG(PSOHAIL)=HLNODE,J=0 S:$D(HLNODE(PSOHAIL)) HLNODE=HLNODE_HLNODE(PSOHAIL) D
- .I $P(PSOMSG(PSOHAIL),"|")="MSA"!($P(PSOMSG(PSOHAIL),"|")="RXR") Q
- .I $P(PSOMSG(PSOHAIL),"|")="ORC" S PSOHORC=PSOMSG(PSOHAIL) Q
- .I $P(PSOMSG(PSOHAIL),"|")="RXD" S PSOHRXD=PSOMSG(PSOHAIL) Q
- .I $P(PSOMSG(PSOHAIL),"|")="NTE" S PSOHNTE=PSOMSG(PSOHAIL)
- S PSOHIEN=$P($P($G(PSOHORC),"|",3),"~") I PSOHIEN'="" S PSOHIENR=$O(^PSRX("B",PSOHIEN,0)) Q:'PSOHIENR
- S PSOHFILL=$P($G(PSOHORC),"|",11),PSOHCHEK=$P($G(PSOHORC),"|",12),PSOHTPE=$P($G(PSOHORC),"|",2)
- S PSOHSUB=$P($G(PSOHRXD),"|",2),PSOS5209=$P($G(PSOHRXD),"|",14),PSOHFLOT=$P($G(PSOHRXD),"|",19)
- S PSOHSEXP=$P($G(PSOHRXD),"|",20),PSOHSMAN=$P($G(PSOHRXD),"|",21)
- S PSOHSNDC=$P($G(PSOHRXD),"|",10)
- S PSOHSEXP=$$FMDATE^HLFNC(PSOHSEXP)
- I PSOS5209 D
- .S $P(^PSRXR(52.09,PSOS5209,0),"^",11)=$G(PSOHFILL)
- .S $P(^PSRXR(52.09,PSOS5209,0),"^",12)=$G(PSOHCHEK)
- .I $G(PSOHNTE)'="" D
- ..S $P(^PSRXR(52.09,PSOS5209,4),"^")=$P(PSOHNTE,"|",4)
- ..I $P(PSOHNTE,"|",4)'="" S ^PSRXR(52.09,"F",$P(PSOHNTE,"|",4),PSOS5209)=""
- ..S $P(^PSRXR(52.09,PSOS5209,4),"^",3)=$P(PSOHNTE,"|",5)
- ..S $P(^PSRXR(52.09,PSOS5209,4),"^",4)=$P(PSOHNTE,"|",6)
- ..S $P(^PSRXR(52.09,PSOS5209,4),"^",5)=$P(PSOHNTE,"|",7)
- Q:'PSOHSUB
- ;
- S:PSOHTPE="RF" $P(^PSRXR(52.09,PSOS5209,0),"^",13)=PSOHSUB
- S:PSOHTPE="PR" $P(^PSRXR(52.09,PSOS5209,0),"^",14)=PSOHSUB
- ;
- I PSOHSUB,PSOHIENR D
- .S PSOHSUBR=$S(PSOHTPE="PR":6,1:$S(PSOHSUB>5:PSOHSUB+1,1:PSOHSUB))
- .D ACT^PSORREF($S(PSOHTPE="RF":"R",1:"P"),PSOHIENR,PSOHSUBR)
- .I $P(^PSRXR(52.09,PSOS5209,4),"^",5) D ACTD^PSORREF("X","HL7 ID "_$P(PSOHNTE,"|",4)_" MESSAGE TRANSMITTED TO "_$P(PSOHNTE,"|",5)_" ("_$P(PSOHNTE,"|",6)_")")
- .D ACTD^PSORREF("N","External Interface Dispensing is Complete.")
- D UPDH^PSORREF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHLDS6 2245 printed Feb 18, 2025@23:56:17 Page 2
- PSOHLDS6 ;BIR/MV - Update Host site for a OneVA fill ; 8/30/21 3:21pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**643,736**;DEC 1997;Build 19
- +2 ;
- HOST ;Update dispensing information at the host site for a OneVa OPAI fill, p736 - handle possible HLNODE overflow nodes
- +1 NEW PSOHAIL,PSOHSUB,PSOHORC,PSOHRXD,PSOMSG,J,PSOHIEN,PSOHIENR,PSOHFILL,PSOHCHEK,PSOS5209,PSOHTPE,PSOHFLOT,PSOHSEXP,PSOHSMAN,PSOHSNDC,PSOHNTE,PSOHSUBR
- +2 NEW ORC
- KILL PSOMSG
- FOR PSOHAIL=1:1
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- SET PSOMSG(PSOHAIL)=HLNODE
- SET J=0
- if $DATA(HLNODE(PSOHAIL))
- SET HLNODE=HLNODE_HLNODE(PSOHAIL)
- Begin DoDot:1
- +3 IF $PIECE(PSOMSG(PSOHAIL),"|")="MSA"!($PIECE(PSOMSG(PSOHAIL),"|")="RXR")
- QUIT
- +4 IF $PIECE(PSOMSG(PSOHAIL),"|")="ORC"
- SET PSOHORC=PSOMSG(PSOHAIL)
- QUIT
- +5 IF $PIECE(PSOMSG(PSOHAIL),"|")="RXD"
- SET PSOHRXD=PSOMSG(PSOHAIL)
- QUIT
- +6 IF $PIECE(PSOMSG(PSOHAIL),"|")="NTE"
- SET PSOHNTE=PSOMSG(PSOHAIL)
- End DoDot:1
- +7 SET PSOHIEN=$PIECE($PIECE($GET(PSOHORC),"|",3),"~")
- IF PSOHIEN'=""
- SET PSOHIENR=$ORDER(^PSRX("B",PSOHIEN,0))
- if 'PSOHIENR
- QUIT
- +8 SET PSOHFILL=$PIECE($GET(PSOHORC),"|",11)
- SET PSOHCHEK=$PIECE($GET(PSOHORC),"|",12)
- SET PSOHTPE=$PIECE($GET(PSOHORC),"|",2)
- +9 SET PSOHSUB=$PIECE($GET(PSOHRXD),"|",2)
- SET PSOS5209=$PIECE($GET(PSOHRXD),"|",14)
- SET PSOHFLOT=$PIECE($GET(PSOHRXD),"|",19)
- +10 SET PSOHSEXP=$PIECE($GET(PSOHRXD),"|",20)
- SET PSOHSMAN=$PIECE($GET(PSOHRXD),"|",21)
- +11 SET PSOHSNDC=$PIECE($GET(PSOHRXD),"|",10)
- +12 SET PSOHSEXP=$$FMDATE^HLFNC(PSOHSEXP)
- +13 IF PSOS5209
- Begin DoDot:1
- +14 SET $PIECE(^PSRXR(52.09,PSOS5209,0),"^",11)=$GET(PSOHFILL)
- +15 SET $PIECE(^PSRXR(52.09,PSOS5209,0),"^",12)=$GET(PSOHCHEK)
- +16 IF $GET(PSOHNTE)'=""
- Begin DoDot:2
- +17 SET $PIECE(^PSRXR(52.09,PSOS5209,4),"^")=$PIECE(PSOHNTE,"|",4)
- +18 IF $PIECE(PSOHNTE,"|",4)'=""
- SET ^PSRXR(52.09,"F",$PIECE(PSOHNTE,"|",4),PSOS5209)=""
- +19 SET $PIECE(^PSRXR(52.09,PSOS5209,4),"^",3)=$PIECE(PSOHNTE,"|",5)
- +20 SET $PIECE(^PSRXR(52.09,PSOS5209,4),"^",4)=$PIECE(PSOHNTE,"|",6)
- +21 SET $PIECE(^PSRXR(52.09,PSOS5209,4),"^",5)=$PIECE(PSOHNTE,"|",7)
- End DoDot:2
- End DoDot:1
- +22 if 'PSOHSUB
- QUIT
- +23 ;
- +24 if PSOHTPE="RF"
- SET $PIECE(^PSRXR(52.09,PSOS5209,0),"^",13)=PSOHSUB
- +25 if PSOHTPE="PR"
- SET $PIECE(^PSRXR(52.09,PSOS5209,0),"^",14)=PSOHSUB
- +26 ;
- +27 IF PSOHSUB
- IF PSOHIENR
- Begin DoDot:1
- +28 SET PSOHSUBR=$SELECT(PSOHTPE="PR":6,1:$SELECT(PSOHSUB>5:PSOHSUB+1,1:PSOHSUB))
- +29 DO ACT^PSORREF($SELECT(PSOHTPE="RF":"R",1:"P"),PSOHIENR,PSOHSUBR)
- +30 IF $PIECE(^PSRXR(52.09,PSOS5209,4),"^",5)
- DO ACTD^PSORREF("X","HL7 ID "_$PIECE(PSOHNTE,"|",4)_" MESSAGE TRANSMITTED TO "_$PIECE(PSOHNTE,"|",5)_" ("_$PIECE(PSOHNTE,"|",6)_")")
- +31 DO ACTD^PSORREF("N","External Interface Dispensing is Complete.")
- End DoDot:1
- +32 DO UPDH^PSORREF
- +33 QUIT