- 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 Feb 18, 2025@23:58:10 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 ;