PSOHLDS6 ;BIR/MV - Update Host site for a OneVA fill ; 8/30/21 3:21pm
;;7.0;OUTPATIENT PHARMACY;**643**;DEC 1997;Build 35
;
HOST ;Update dispensing information at the host site for a OneVa OPAI fill
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 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 2143 printed Apr 09, 2024@21:26:21 Page 2
PSOHLDS6 ;BIR/MV - Update Host site for a OneVA fill ; 8/30/21 3:21pm
+1 ;;7.0;OUTPATIENT PHARMACY;**643**;DEC 1997;Build 35
+2 ;
HOST ;Update dispensing information at the host site for a OneVa OPAI fill
+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
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
