PSOORAL2 ;BHAM-ISC/SAB - build listman activity logs con't ;Feb 10, 2022@10:12:50
;;7.0;OUTPATIENT PHARMACY;**258,260,386,427,454,482,441**;DEC 1997;Build 208
;
RF ;refill log
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Refill Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Refill Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
S (RF,PL)=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF S PL=PL+1
I 'PL S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Refills For this Prescription" Q
F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D
.S DTT=$P(P1,"^",8)\1 D DAT S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" "
.S DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)_" "_$S($P(P1,"^",2)="M":"Mail",$P(P1,"^",2)="P":"Park",1:"Window")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12)
.; grab remote fill information as part of OneVA project
.; and display if available
.N REMOTEF,REMOTEPH,REMOTES
.S REMOTEF=$G(^PSRX(DA,1,N,"RF")),REMOTEPH=$P(REMOTEF,U,2),REMOTES=$P(REMOTEF,U)
.I REMOTES D
.. S REMOTES=$$FIND1^DIC(4,,"X",REMOTES,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
.. I 'REMOTES S REMOTES="" Q
.. S REMOTES=$$GET1^DIQ(4,REMOTES_",",99)
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_$E($S(REMOTEPH]"":REMOTEPH,$D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16)
.S PSDIV=$S(REMOTES]"":REMOTES,$D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown"),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_$E(" ",$L(PSDIV)+1,8)_" "
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_" "
.S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))
.; Always display the NDC# - PSO*7*427
.S RTS=RTS_" NDC: "_$$GETNDC^PSONDCUT(DA,N)
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RTS S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Remarks: "_$P(P1,"^",3)
K RTS Q
PAR ;partial log
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Partial Fills:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
I '$O(^PSRX(DA,"P",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Partials for this Prescription" Q
S N=0 F S N=$O(^PSRX(DA,"P",N)) Q:'N S P1=^(N,0),DTT=$P(P1,"^",8)\1 D DAT D
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" ",QTY=$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)
.S DTT=$P(P1,"^") D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_QTY_" "
.; grab remote fill information as part of OneVA project
.; and display if available
.N REMOTEF,REMOTEPH,REMOTES
.S REMOTEF=$G(^PSRX(DA,"P",N,"PF")),REMOTEPH=$P(REMOTEF,U,2),REMOTES=$P(REMOTEF,U)
.I REMOTES D
.. S REMOTES=$$FIND1^DIC(4,,"X",REMOTES,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
.. I 'REMOTES S REMOTES="" Q
.. S REMOTES=$$GET1^DIQ(4,REMOTES_",",99)
.S PSDIV=$S(REMOTES]"":REMOTES,$D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),PSDIV=PSDIV_$E(" ",$L(PSDIV)+1,8)
.S MW=$S($P(P1,"^",2)="M":"Mail",1:"Window"),MW=MW_$E(" ",$L(MW)+1,10)
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_MW_" "_$P(P1,"^",6)_$E(" ",$L($P(P1,"^",6))+1,10)_$E($S(REMOTEPH]"":REMOTEPH,$D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16)
.S RTS=$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:""))
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_" "_RTS ;_" Entry By: "_$P(^VA(200,$P(P1,"^",7),0),"^")
.S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" REMARKS: "_$P(P1,"^",3) K RTS
Q
HLD ;hold info
S DTT=$P(^PSRX(DA,"H"),"^",3) D DAT S HLDR=$$GET1^DIQ(52,DA,99)
S $P(RN," ",60)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Reason: "_HLDR_$E(RN,$L("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT
I $P($G(^PSRX(DA,"H")),"^",2)]"" D
. N HLDCOMM S HLDCOMM=$P(^PSRX(DA,"H"),"^",2)
. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Comments: "_$E(HLDCOMM,1,65),HLDCOMM=$E(HLDCOMM,66,999)
. F Q:HLDCOMM="" D
. . S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "_$E(HLDCOMM,1,65),HLDCOMM=$E(HLDCOMM,66,999)
K RN,DAT,DTT,HLDR
Q
DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORAL2 4846 printed Oct 16, 2024@18:32:22 Page 2
PSOORAL2 ;BHAM-ISC/SAB - build listman activity logs con't ;Feb 10, 2022@10:12:50
+1 ;;7.0;OUTPATIENT PHARMACY;**258,260,386,427,454,482,441**;DEC 1997;Build 208
+2 ;
RF ;refill log
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Refill Log:"
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Log Date Refill Date Qty Routing Lot # Pharmacist"
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+3 SET (RF,PL)=0
FOR RF=0:0
SET RF=$ORDER(^PSRX(DA,1,RF))
if 'RF
QUIT
SET PL=PL+1
+4 IF 'PL
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Refills For this Prescription"
QUIT
+5 FOR N=0:0
SET N=$ORDER(^PSRX(DA,1,N))
if 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+6 SET DTT=$PIECE(P1,"^",8)\1
DO DAT
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=N_" "_DAT_" "
+7 SET DTT=$PIECE(P1,"^")
SET $PIECE(RN," ",10)=" "
DO DAT
+8 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT_" "_$PIECE(P1,"^",4)_$EXTRACT(" ",$LENGTH(...
... $PIECE(P1,"^",4))+1,15)_" "_$SELECT($PIECE(P1,"^",2)="M":"Mail",$PIECE(P1,"^",2)="P":"Park",1:"Window")_" "_$PIECE(P1,"^",6)_$EXTRACT(RN,$LENGTH($PIECE(P1,"^",6))+1,12)
+9 ; grab remote fill information as part of OneVA project
+10 ; and display if available
+11 NEW REMOTEF,REMOTEPH,REMOTES
+12 SET REMOTEF=$GET(^PSRX(DA,1,N,"RF"))
SET REMOTEPH=$PIECE(REMOTEF,U,2)
SET REMOTES=$PIECE(REMOTEF,U)
+13 IF REMOTES
Begin DoDot:2
+14 SET REMOTES=$$FIND1^DIC(4,,"X",REMOTES,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
+15 IF 'REMOTES
SET REMOTES=""
QUIT
+16 SET REMOTES=$$GET1^DIQ(4,REMOTES_",",99)
End DoDot:2
+17 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_$EXTRACT($SELECT(REMOTEPH]"":REMOTEPH,$DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16)
+18 SET PSDIV=$SELECT(REMOTES]"":REMOTES,$DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"Unknown")
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Division: "_PSDIV_$EXTRACT(" ",$LENGTH(PSDIV)+1,8)_" "
+19 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"Dispensed: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",19),2,3),1:"")_" "
+20 SET RTS=$SELECT($PIECE(P1,"^",16):" Returned to Stock: "_$EXTRACT($PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" Released: "_...
... $SELECT($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))
+21 ; Always display the NDC# - PSO*7*427
+22 SET RTS=RTS_" NDC: "_$$GETNDC^PSONDCUT(DA,N)
+23 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RTS
if $PIECE(P1,"^",3)]""
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Remarks: "_$PIECE(P1,"^",3)
End DoDot:1
+24 KILL RTS
QUIT
PAR ;partial log
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Partial Fills:"
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Log Date Date Qty Routing Lot # Pharmacist"
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+3 IF '$ORDER(^PSRX(DA,"P",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Partials for this Prescription"
QUIT
+4 SET N=0
FOR
SET N=$ORDER(^PSRX(DA,"P",N))
if 'N
QUIT
SET P1=^(N,0)
SET DTT=$PIECE(P1,"^",8)\1
DO DAT
Begin DoDot:1
+5 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=N_" "_DAT_" "
SET QTY=$PIECE(P1,"^",4)_$EXTRACT(" ",$LENGTH($PIECE(P1,"^",4))+1,15)
+6 SET DTT=$PIECE(P1,"^")
DO DAT
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT_" "_QTY_" "
+7 ; grab remote fill information as part of OneVA project
+8 ; and display if available
+9 NEW REMOTEF,REMOTEPH,REMOTES
+10 SET REMOTEF=$GET(^PSRX(DA,"P",N,"PF"))
SET REMOTEPH=$PIECE(REMOTEF,U,2)
SET REMOTES=$PIECE(REMOTEF,U)
+11 IF REMOTES
Begin DoDot:2
+12 SET REMOTES=$$FIND1^DIC(4,,"X",REMOTES,"D","I $P(^(0),U,11)=""N"",'$P($G(^(99)),U,4)")
+13 IF 'REMOTES
SET REMOTES=""
QUIT
+14 SET REMOTES=$$GET1^DIQ(4,REMOTES_",",99)
End DoDot:2
+15 SET PSDIV=$SELECT(REMOTES]"":REMOTES,$DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"UNKNOWN")
SET PSDIV=PSDIV_$EXTRACT(" ",$LENGTH(PSDIV)+1,8)
+16 SET MW=$SELECT($PIECE(P1,"^",2)="M":"Mail",1:"Window")
SET MW=MW_$EXTRACT(" ",$LENGTH(MW)+1,10)
+17 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_MW_" "_$PIECE(P1,"^",6)_$EXTRACT(" ",$LENGTH($PIECE(P1,"^",6))+1,10)_$EXTRACT($SELECT(REMOTEPH]"":REMOTEPH,$DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16
)
+18 SET RTS=$SELECT($PIECE(P1,"^",16):" RETURNED TO STOCK: "_$EXTRACT(...
... $PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" RELEASED: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",
19),2,3),1:""))
+19 ;_" Entry By: "_$P(^VA(200,$P(P1,"^",7),0),"^")
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Division: "_PSDIV_" "_RTS
+20 if $PIECE(P1,"^",3)]""
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" REMARKS: "_$PIECE(P1,"^",3)
KILL RTS
End DoDot:1
+21 QUIT
HLD ;hold info
+1 SET DTT=$PIECE(^PSRX(DA,"H"),"^",3)
DO DAT
SET HLDR=$$GET1^DIQ(52,DA,99)
+2 SET $PIECE(RN," ",60)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Hold Reason: "_HLDR_$EXTRACT(RN,$LENGTH("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT
+3 IF $PIECE($GET(^PSRX(DA,"H")),"^",2)]""
Begin DoDot:1
+4 NEW HLDCOMM
SET HLDCOMM=$PIECE(^PSRX(DA,"H"),"^",2)
+5 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Hold Comments: "_$EXTRACT(HLDCOMM,1,65)
SET HLDCOMM=$EXTRACT(HLDCOMM,66,999)
+6 FOR
if HLDCOMM=""
QUIT
Begin DoDot:2
+7 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "_$EXTRACT(HLDCOMM,1,65)
SET HLDCOMM=$EXTRACT(HLDCOMM,66,999)
End DoDot:2
End DoDot:1
+8 KILL RN,DAT,DTT,HLDR
+9 QUIT
DAT SET DAT=""
SET DTT=DTT\1
if DTT'?7N
QUIT
SET DAT=$EXTRACT(DTT,4,5)_"/"_$EXTRACT(DTT,6,7)_"/"_$EXTRACT(DTT,2,3)
+1 QUIT
