PSOORAL3 ;BHAM ISC/MV - Build Listman activity log extension ; 12/4/07 12:25pm
;;7.0;OUTPATIENT PHARMACY;**643**;DEC 1997;Build 35
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,PSOP4=0:1,PSOP2="P":1,1:0) S PSOCHK=$$PFCHK(PSOIEN,$P(P1,U),,PSOFLG) Q:PSOCHK]"" PSOCHK
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)
Q $G(PSOCHK)
;
RFCHK(PSOIEN,PSOP4,PSOFLG) ;
NEW PSOX1,PSOX2,PSOXRF,PSOXDIC4,PSOXRF,PSORFDT,PSOSNUM,PSOSNUMX,PSOSNAME
Q:'+$G(PSOIEN) ""
Q:'+$G(PSOP4) ""
I PSOP4>6 S PSOP4=PSOP4-1
S PSOXRF=$G(^PSRX(PSOIEN,1,PSOP4,"RF")),PSOSNUM=$P(PSOXRF,U)
S PSOSNAME="",PSOX1=""
I PSOSNUM]"" S PSOSNAME=$$STATION(PSOSNUM)
S:PSOSNAME]"" PSOX1=$S(+$G(PSOFLG):" at ",1:" Processed at ")_PSOSNAME
S PSOX2=PSOX1_U_$P(PSOXRF,U,2,6)
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>0),(PSORN<12) D
.S PSOX1=$G(^PSRX(PSOIEN,1,PSORN,"RF"))
.S PSOSNAME=$$STATION($P(PSOX1,U))
.S:PSOSNAME]"" PSOTXT=" Printed at "_PSOSNAME
.S PSORDATA=PSOTXT_U_$P(PSOX1,U,2,6)
;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 6024 printed Dec 13, 2024@02:31:44 Page 2
PSOORAL3 ;BHAM ISC/MV - Build Listman activity log extension ; 12/4/07 12:25pm
+1 ;;7.0;OUTPATIENT PHARMACY;**643**;DEC 1997;Build 35
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 IF $SELECT(PSOP2="P":1,PSOP2="X":1,PSOP2="N":1,1:0)
IF $SELECT(PSOP4=6:1,PSOP4=0: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 QUIT $GET(PSOCHK)
+11 ;
RFCHK(PSOIEN,PSOP4,PSOFLG) ;
+1 NEW PSOX1,PSOX2,PSOXRF,PSOXDIC4,PSOXRF,PSORFDT,PSOSNUM,PSOSNUMX,PSOSNAME
+2 if '+$GET(PSOIEN)
QUIT ""
+3 if '+$GET(PSOP4)
QUIT ""
+4 IF PSOP4>6
SET PSOP4=PSOP4-1
+5 SET PSOXRF=$GET(^PSRX(PSOIEN,1,PSOP4,"RF"))
SET PSOSNUM=$PIECE(PSOXRF,U)
+6 SET PSOSNAME=""
SET PSOX1=""
+7 IF PSOSNUM]""
SET PSOSNAME=$$STATION(PSOSNUM)
+8 if PSOSNAME]""
SET PSOX1=$SELECT(+$GET(PSOFLG):" at ",1:" Processed at ")_PSOSNAME
+9 SET PSOX2=PSOX1_U_$PIECE(PSOXRF,U,2,6)
+10 QUIT $GET(PSOX2)
+11 ;
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 IF (PSORN>0)
IF (PSORN<12)
Begin DoDot:1
+7 SET PSOX1=$GET(^PSRX(PSOIEN,1,PSORN,"RF"))
+8 SET PSOSNAME=$$STATION($PIECE(PSOX1,U))
+9 if PSOSNAME]""
SET PSOTXT=" Printed at "_PSOSNAME
+10 SET PSORDATA=PSOTXT_U_$PIECE(PSOX1,U,2,6)
End DoDot:1
+11 ;If there's no Refill with the same date as the label log date, check the partial fill entries.
+12 IF PSORN
IF ($GET(PSORDATA)="")
SET PSORDATA=$$PFCHK(PSOIEN,PSOLBLDT,1)
+13 QUIT PSORDATA
+14 ;
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 ;
