PSOORAL3 ;BHAM ISC/MV,RBD - Build Listman activity log extension ;18 Feb 2025 8:56 AM
;;7.0;OUTPATIENT PHARMACY;**643,774**;DEC 1997;Build 15
ACT ;activity log
N CNT,PSORDATA,PSOTXT,PSOTXT1,PSOTXT2,X
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Activity Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date/Time Reason Rx Ref Initiator Of Activity",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
I '$O(^PSRX(DA,"A",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Activity to report" Q
S CNT=0
F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N S P1=^(N,0) D
.I $P(P1,"^",2)="M" Q
.S PSORDATA="",PSOTXT="",PSOTXT1="",PSOTXT2=""
.S DAT=$$FMTE^XLFDT($P(P1,"^"),2)_" "
.S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_$S(CNT<10:" ",1:" ")_$E(DAT,1,21),$P(RN," ",15)=" ",REA=$P(P1,"^",2)
.S REA=$F("HUCELPRWSIVDABXGKNO",REA)-1
.I REA D
..S STA=$P("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^IERX^","^",REA)
..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,15)
.E S $P(STA," ",15)=" ",^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA
.K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)
.S RFT=$S(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")
.S PSORDATA=$$REMDATA(DA,P1)
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$E(RN,$L(RFT)+1,15)_$E($S($P(PSORDATA,"^",2)]"":$P(PSORDATA,"^",2),$D(^VA(200,+$P(P1,"^",3),0)):$P(^(0),"^"),1:$P(P1,"^",3)),1,24)
.I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D
..K PSOTXT S PSOACBRV=$P(P1,"^",5)_$P(PSORDATA,"^")
..I (($L(PSOACBRV)#59)<$L($P(PSORDATA,"^"))),($P(PSORDATA,"^")]"") S PSOACBRV=$P(P1,"^",5),PSOTXT=" "_$P(PSORDATA,"^")
..K ^UTILITY($J,"W") S X=PSOACBRV,(DIWR,DIWL)=1,DIWF="C69" D ^DIWP F I=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$S(I=1:"Comments: ",1:" ")_$G(^UTILITY($J,"W",1,I,0))
..I $G(PSOTXT)]"" S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=PSOTXT K PSOTXT
..S PSOTXT1=$P(PSORDATA,"^",6),PSOTXT2=$P(PSORDATA,"^",5)
..I $P(P1,U,2)="N" D
...I $L(PSOTXT1_PSOTXT2)>25 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Filled By: "_PSOTXT1,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Checking Pharmacist: "_PSOTXT2
...I ($L(PSOTXT1_PSOTXT2)<26),($L(PSOTXT1_PSOTXT2)>1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Filled By: "_$S(PSOTXT1="":" ",1:PSOTXT1)_" Checking Pharmacist: "_PSOTXT2
.I $P($G(^PSRX(DA,"A",N,1)),"^")]"" S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",5)=$P($G(^PSRX(DA,"A",N,1)),"^") I $P($G(^PSRX(DA,"A",N,1)),"^",2)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_":"_$P($G(^PSRX(DA,"A",N,1)),"^",2)
.I $O(^PSRX(DA,"A",N,2,0)) F I=0:0 S I=$O(^PSRX(DA,"A",N,2,I)) Q:'I S MIG=^PSRX(DA,"A",N,2,I,0) D
..S:MIG["Mail Tracking Info.: " IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" "
..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)
K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR
Q
;
REMDATA(PSOIEN,P1) ;
;Check if activity log needs to display the remote pharmacist (OneVA)
;P1 - ^PSRX(D0,"A",D1,0)
NEW PSOPF,PSOCHK,PSORMTE,PSORPH,PSOP2,PSOP3,PSOP4,PSOFLG
Q:+'$G(PSOIEN) ""
Q:$G(P1)="" ""
S PSOPF=0,PSOP2=$P(P1,U,2),PSOP3=$P(P1,U,3),PSOP4=$P(P1,U,4)
S PSOFLG=$S($P(P1,U,5)["HL7 ID":1,1:0)
I $S(PSOP2="P":1,PSOP2="X":1,PSOP2="N":1,1:0),$S(PSOP4=6:1,PSOP2="P":1,1:0) S PSOCHK=$$PFCHK(PSOIEN,$P(P1,U),,PSOFLG) Q:PSOCHK]"" PSOCHK ; took out PSOP4=0 from $S *774* WLC
I $S(PSOP2="X":1,PSOP2="N":1,1:0),$S(((PSOP4>0)&(PSOP4<6)):+PSOP4,((PSOP4>6)&(PSOP4<13)):1,1:0) S PSOCHK=$$RFCHK(PSOIEN,PSOP4,PSOFLG)
I $S(PSOP2="X":1,PSOP2="N":1,1:0),PSOP4=0 S PSOCHK=$$RFCHK(PSOIEN,PSOP4,PSOFLG) ; RBD *774 Original Fill path (PSOP4 = 0)
Q $G(PSOCHK)
;
RFCHK(PSOIEN,PSOP4,PSOFLG) ;
NEW PSOX1,PSOX2,PSOXRF,PSOXDIC4,PSOXRF,PSORFDT,PSOSNUM,PSOSNUMX,PSOSNAME
Q:'+$G(PSOIEN) ""
Q:$G(PSOP4)="" "" ; Q:'+$G(PSOP4) "" RBD *774 PSOP4 = 0 (denoting Original Fill) allowed through
I PSOP4>6 S PSOP4=PSOP4-1
S:PSOP4=0 PSOXRF=$G(^PSRX(PSOIEN,"OF")) ; RBD *774 Pick top-file level "OF" node when PSOP4 = 0
S:PSOP4>0 PSOXRF=$G(^PSRX(PSOIEN,1,PSOP4,"RF")) ; RBD *774 Check PSOP4 > 0 before accessing "RF" node
S PSOSNUM=$P(PSOXRF,U) ; RBD *774 Moved this to its own line since PSOXRF can be from "OF" now also
S PSOSNAME="",PSOX1=""
I PSOSNUM]"" S PSOSNAME=$$STATION(PSOSNUM)
S:PSOSNAME]"" PSOX1=$S(+$G(PSOFLG):" at ",1:" Processed at ")_PSOSNAME
I PSOP4=0 S PSOX2=PSOX1_U_$P(PSOXRF,U,2,3)_U_U_$P(PSOXRF,U,4,5) ; RBD *774 PSOP4 = 0: Use "OF" node
S:PSOP4>0 PSOX2=PSOX1_U_$P(PSOXRF,U,2,6) ; RBD *774 Check PSOP4 > 0 ("RF" node path)
Q $G(PSOX2)
;
PFCHK(PSOIEN,PSODT,PSOLBL,PSOFLG) ;
;PSODT - LBLDATA set this date to 7 digit length so it can match to the "PF" OneVA .01 field.
;PSOLBL - 1 if calling from LBLDATA
;PSOX2 - Site name (station #) ^ remote pharmacist
NEW PSOX,PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4,PSOPFDT,PSOSNUMX,PSOSNAME,PSOX1
Q:'+$G(PSOIEN) ""
Q:$G(PSODT)="" ""
;Using the 52.02,01 PARTIAL DATE because OneVA partial fill can't back dated.
F PSOX=0:0 S PSOX=$O(^PSRX(PSOIEN,"P",PSOX)) Q:'PSOX D Q:$G(PSOX2)]""
.S PSOPFDT=$P($G(^PSRX(PSOIEN,"P",PSOX,0)),U)
.I $S(PSOPFDT=PSODT:1,PSOPFDT=$E(PSODT,1,7):1,1:0) D
..K PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4
..S PSOXPF=$G(^PSRX(PSOIEN,"P",PSOX,"PF")),PSOSNUM=$P(PSOXPF,U)
..S PSOSNAME="",PSOX1=""
..S PSOSNAME=$$STATION(PSOSNUM)
..S:PSOSNAME]"" PSOX1=$S($G(PSOLBL):" Printed at ",1:$S(+$G(PSOFLG):" at ",1:" Processed at "))_PSOSNAME
..S PSOX2=PSOX1_U_$P(PSOXPF,U,2,6)
Q $G(PSOX2)
;
LBLDATA(PSOIEN,LBL) ;
NEW PSORDATA,PSOLBLDT,PSORN,PSOX1,PSOLBLDT,PSOTXT,PSOSNAME
Q:+'$G(PSOIEN) ""
Q:$G(LBL)="" ""
;check if label entry is related to a refill
S PSOTXT="",PSORDATA="",PSORN=+$P(LBL,U,2),PSOLBLDT=$P(LBL,U)
I (PSORN>-1),(PSORN<12) D ; RBD *774 Update 0 to -1 so Original Fill covered
.S:PSORN=0 PSOX1=$G(^PSRX(PSOIEN,"OF")) ; RBD *774 Use "OF" node when PSORN = 0
.S:PSORN>0 PSOX1=$G(^PSRX(PSOIEN,1,PSORN,"RF")) ; RBD *774 Use "RF" node when PSORN > 0
.S PSOSNAME=$$STATION($P(PSOX1,U))
.S:PSOSNAME]"" PSOTXT=" Printed at "_PSOSNAME
.S:PSORN=0 PSORDATA=PSOTXT_U_$P(PSOX1,U,2,3)_U_U_$P(PSOX1,U,4,5) ; RBD *774 PSORN = 0: Pull info from "OF" node
.S:PSORN>0 PSORDATA=PSOTXT_U_$P(PSOX1,U,2,6) ; RBD *774 PSORN > 0: Pull info from "RF" node
;If there's no Refill with the same date as the label log date, check the partial fill entries.
I PSORN,($G(PSORDATA)="") S PSORDATA=$$PFCHK(PSOIEN,PSOLBLDT,1)
Q PSORDATA
;
STATION(PSOSNUM) ;
NEW PSOXDIC4,PSOTXT
Q:$G(PSOSNUM)="" ""
D F4^XUAF4(PSOSNUM,.PSOXDIC4)
I $G(PSOXDIC4("NAME"))]"" S PSOTXT=PSOXDIC4("NAME")_" ("_PSOSNUM_")"
Q $G(PSOTXT)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORAL3 7042 printed Sep 23, 2025@20:08:10 Page 2
PSOORAL3 ;BHAM ISC/MV,RBD - Build Listman activity log extension ;18 Feb 2025 8:56 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**643,774**;DEC 1997;Build 15
ACT ;activity log
+1 NEW CNT,PSORDATA,PSOTXT,PSOTXT1,PSOTXT2,X
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Activity Log:"
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date/Time Reason Rx Ref Initiator Of Activity"
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+4 IF '$ORDER(^PSRX(DA,"A",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO Activity to report"
QUIT
+5 SET CNT=0
+6 FOR N=0:0
SET N=$ORDER(^PSRX(DA,"A",N))
if 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+7 IF $PIECE(P1,"^",2)="M"
QUIT
+8 SET PSORDATA=""
SET PSOTXT=""
SET PSOTXT1=""
SET PSOTXT2=""
+9 SET DAT=$$FMTE^XLFDT($PIECE(P1,"^"),2)_" "
+10 SET IEN=IEN+1
SET CNT=CNT+1
SET ^TMP("PSOAL",$JOB,IEN,0)=CNT_$SELECT(CNT<10:" ",1:" ")_$EXTRACT(DAT,1,21)
SET $PIECE(RN," ",15)=" "
SET REA=$PIECE(P1,"^",2)
+11 SET REA=$FIND("HUCELPRWSIVDABXGKNO",REA)-1
+12 IF REA
Begin DoDot:2
+13 SET STA=$PIECE("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^IERX^","^",REA)
+14 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA_$EXTRACT(RN,$LENGTH(STA)+1,15)
End DoDot:2
+15 IF '$TEST
SET $PIECE(STA," ",15)=" "
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA
+16 KILL STA,RN
SET $PIECE(RN," ",15)=" "
SET RF=+$PIECE(P1,"^",4)
+17 SET RFT=$SELECT(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")
+18 SET PSORDATA=$$REMDATA(DA,P1)
+19 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$EXTRACT(RN,$LENGTH(RFT)+1,15)_$EXTRACT($SELECT($PIECE(PSORDATA,"^",2)]"":$PIECE(PSORDATA,"^",2),$DATA(^VA(200,+$PIECE(P1,"^",3),0)):$PIECE(^(0),"^"),1:$PIECE(P1,"^",3)),1,24)
+20 IF $PIECE(P1,"^",5)]""
NEW PSOACBRK,PSOACBRV
Begin DoDot:2
+21 KILL PSOTXT
SET PSOACBRV=$PIECE(P1,"^",5)_$PIECE(PSORDATA,"^")
+22 IF (($LENGTH(PSOACBRV)#59)<$LENGTH($PIECE(PSORDATA,"^")))
IF ($PIECE(PSORDATA,"^")]"")
SET PSOACBRV=$PIECE(P1,"^",5)
SET PSOTXT=" "_$PIECE(PSORDATA,"^")
+23 KILL ^UTILITY($JOB,"W")
SET X=PSOACBRV
SET (DIWR,DIWL)=1
SET DIWF="C69"
DO ^DIWP
FOR I=1:1:^UTILITY($JOB,"W",1)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=$SELECT(I=1:"Comments: ",1:" ")_$GET(^UTILITY($JOB,"W",1,I,0))
+24 IF $GET(PSOTXT)]""
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=PSOTXT
KILL PSOTXT
+25 SET PSOTXT1=$PIECE(PSORDATA,"^",6)
SET PSOTXT2=$PIECE(PSORDATA,"^",5)
+26 IF $PIECE(P1,U,2)="N"
Begin DoDot:3
+27 IF $LENGTH(PSOTXT1_PSOTXT2)>25
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Filled By: "_PSOTXT1
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Checking Pharmacist: "_PSOTXT2
+28 IF ($LENGTH(PSOTXT1_PSOTXT2)<26)
IF ($LENGTH(PSOTXT1_PSOTXT2)>1)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Filled By: "_$SELECT(PSOTXT1="":" ",1:PSOTXT1)_" Checking Pharmacist: "_PSOTXT2
End DoDot:3
End DoDot:2
+29 IF $PIECE($GET(^PSRX(DA,"A",N,1)),"^")]""
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",5)=$PIECE($GET(^PSRX(DA,"A",N,1)),"^")
IF $PIECE($GET(^PSRX(DA,"A",N,1)),"^",2)]""
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_":"_$PIECE($GET(^PSRX(DA,"A",N,1)),"^",2)
+30 IF $ORDER(^PSRX(DA,"A",N,2,0))
FOR I=0:0
SET I=$ORDER(^PSRX(DA,"A",N,2,I))
if 'I
QUIT
SET MIG=^PSRX(DA,"A",N,2,I,0)
Begin DoDot:2
+31 if MIG["Mail Tracking Info.
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "
+32 FOR SG=1:1:$LENGTH(MIG)
if $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "
if $PIECE(MIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:2
End DoDot:1
+33 KILL MIG,SG,I,^UTILITY($JOB,"W"),DIWF,DIWL,DIWR
+34 QUIT
+35 ;
REMDATA(PSOIEN,P1) ;
+1 ;Check if activity log needs to display the remote pharmacist (OneVA)
+2 ;P1 - ^PSRX(D0,"A",D1,0)
+3 NEW PSOPF,PSOCHK,PSORMTE,PSORPH,PSOP2,PSOP3,PSOP4,PSOFLG
+4 if +'$GET(PSOIEN)
QUIT ""
+5 if $GET(P1)=""
QUIT ""
+6 SET PSOPF=0
SET PSOP2=$PIECE(P1,U,2)
SET PSOP3=$PIECE(P1,U,3)
SET PSOP4=$PIECE(P1,U,4)
+7 SET PSOFLG=$SELECT($PIECE(P1,U,5)["HL7 ID":1,1:0)
+8 ; took out PSOP4=0 from $S *774* WLC
IF $SELECT(PSOP2="P":1,PSOP2="X":1,PSOP2="N":1,1:0)
IF $SELECT(PSOP4=6:1,PSOP2="P":1,1:0)
SET PSOCHK=$$PFCHK(PSOIEN,$PIECE(P1,U),,PSOFLG)
if PSOCHK]""
QUIT PSOCHK
+9 IF $SELECT(PSOP2="X":1,PSOP2="N":1,1:0)
IF $SELECT(((PSOP4>0)&(PSOP4<6)):+PSOP4,((PSOP4>6)&(PSOP4<13)):1,1:0)
SET PSOCHK=$$RFCHK(PSOIEN,PSOP4,PSOFLG)
+10 ; RBD *774 Original Fill path (PSOP4 = 0)
IF $SELECT(PSOP2="X":1,PSOP2="N":1,1:0)
IF PSOP4=0
SET PSOCHK=$$RFCHK(PSOIEN,PSOP4,PSOFLG)
+11 QUIT $GET(PSOCHK)
+12 ;
RFCHK(PSOIEN,PSOP4,PSOFLG) ;
+1 NEW PSOX1,PSOX2,PSOXRF,PSOXDIC4,PSOXRF,PSORFDT,PSOSNUM,PSOSNUMX,PSOSNAME
+2 if '+$GET(PSOIEN)
QUIT ""
+3 ; Q:'+$G(PSOP4) "" RBD *774 PSOP4 = 0 (denoting Original Fill) allowed through
if $GET(PSOP4)=""
QUIT ""
+4 IF PSOP4>6
SET PSOP4=PSOP4-1
+5 ; RBD *774 Pick top-file level "OF" node when PSOP4 = 0
if PSOP4=0
SET PSOXRF=$GET(^PSRX(PSOIEN,"OF"))
+6 ; RBD *774 Check PSOP4 > 0 before accessing "RF" node
if PSOP4>0
SET PSOXRF=$GET(^PSRX(PSOIEN,1,PSOP4,"RF"))
+7 ; RBD *774 Moved this to its own line since PSOXRF can be from "OF" now also
SET PSOSNUM=$PIECE(PSOXRF,U)
+8 SET PSOSNAME=""
SET PSOX1=""
+9 IF PSOSNUM]""
SET PSOSNAME=$$STATION(PSOSNUM)
+10 if PSOSNAME]""
SET PSOX1=$SELECT(+$GET(PSOFLG):" at ",1:" Processed at ")_PSOSNAME
+11 ; RBD *774 PSOP4 = 0: Use "OF" node
IF PSOP4=0
SET PSOX2=PSOX1_U_$PIECE(PSOXRF,U,2,3)_U_U_$PIECE(PSOXRF,U,4,5)
+12 ; RBD *774 Check PSOP4 > 0 ("RF" node path)
if PSOP4>0
SET PSOX2=PSOX1_U_$PIECE(PSOXRF,U,2,6)
+13 QUIT $GET(PSOX2)
+14 ;
PFCHK(PSOIEN,PSODT,PSOLBL,PSOFLG) ;
+1 ;PSODT - LBLDATA set this date to 7 digit length so it can match to the "PF" OneVA .01 field.
+2 ;PSOLBL - 1 if calling from LBLDATA
+3 ;PSOX2 - Site name (station #) ^ remote pharmacist
+4 NEW PSOX,PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4,PSOPFDT,PSOSNUMX,PSOSNAME,PSOX1
+5 if '+$GET(PSOIEN)
QUIT ""
+6 if $GET(PSODT)=""
QUIT ""
+7 ;Using the 52.02,01 PARTIAL DATE because OneVA partial fill can't back dated.
+8 FOR PSOX=0:0
SET PSOX=$ORDER(^PSRX(PSOIEN,"P",PSOX))
if 'PSOX
QUIT
Begin DoDot:1
+9 SET PSOPFDT=$PIECE($GET(^PSRX(PSOIEN,"P",PSOX,0)),U)
+10 IF $SELECT(PSOPFDT=PSODT:1,PSOPFDT=$EXTRACT(PSODT,1,7):1,1:0)
Begin DoDot:2
+11 KILL PSOX1,PSOX2,PSOXPF,PSOSNUM,PSOXDIC4
+12 SET PSOXPF=$GET(^PSRX(PSOIEN,"P",PSOX,"PF"))
SET PSOSNUM=$PIECE(PSOXPF,U)
+13 SET PSOSNAME=""
SET PSOX1=""
+14 SET PSOSNAME=$$STATION(PSOSNUM)
+15 if PSOSNAME]""
SET PSOX1=$SELECT($GET(PSOLBL):" Printed at ",1:$SELECT(+$GET(PSOFLG):" at ",1:" Processed at "))_PSOSNAME
+16 SET PSOX2=PSOX1_U_$PIECE(PSOXPF,U,2,6)
End DoDot:2
End DoDot:1
if $GET(PSOX2)]""
QUIT
+17 QUIT $GET(PSOX2)
+18 ;
LBLDATA(PSOIEN,LBL) ;
+1 NEW PSORDATA,PSOLBLDT,PSORN,PSOX1,PSOLBLDT,PSOTXT,PSOSNAME
+2 if +'$GET(PSOIEN)
QUIT ""
+3 if $GET(LBL)=""
QUIT ""
+4 ;check if label entry is related to a refill
+5 SET PSOTXT=""
SET PSORDATA=""
SET PSORN=+$PIECE(LBL,U,2)
SET PSOLBLDT=$PIECE(LBL,U)
+6 ; RBD *774 Update 0 to -1 so Original Fill covered
IF (PSORN>-1)
IF (PSORN<12)
Begin DoDot:1
+7 ; RBD *774 Use "OF" node when PSORN = 0
if PSORN=0
SET PSOX1=$GET(^PSRX(PSOIEN,"OF"))
+8 ; RBD *774 Use "RF" node when PSORN > 0
if PSORN>0
SET PSOX1=$GET(^PSRX(PSOIEN,1,PSORN,"RF"))
+9 SET PSOSNAME=$$STATION($PIECE(PSOX1,U))
+10 if PSOSNAME]""
SET PSOTXT=" Printed at "_PSOSNAME
+11 ; RBD *774 PSORN = 0: Pull info from "OF" node
if PSORN=0
SET PSORDATA=PSOTXT_U_$PIECE(PSOX1,U,2,3)_U_U_$PIECE(PSOX1,U,4,5)
+12 ; RBD *774 PSORN > 0: Pull info from "RF" node
if PSORN>0
SET PSORDATA=PSOTXT_U_$PIECE(PSOX1,U,2,6)
End DoDot:1
+13 ;If there's no Refill with the same date as the label log date, check the partial fill entries.
+14 IF PSORN
IF ($GET(PSORDATA)="")
SET PSORDATA=$$PFCHK(PSOIEN,PSOLBLDT,1)
+15 QUIT PSORDATA
+16 ;
STATION(PSOSNUM) ;
+1 NEW PSOXDIC4,PSOTXT
+2 if $GET(PSOSNUM)=""
QUIT ""
+3 DO F4^XUAF4(PSOSNUM,.PSOXDIC4)
+4 IF $GET(PSOXDIC4("NAME"))]""
SET PSOTXT=PSOXDIC4("NAME")_" ("_PSOSNUM_")"
+5 QUIT $GET(PSOTXT)
+6 ;
