PSO635PO ;ALB/BWF^PSO*7*635 POST INIT ; 02/10/2021 1:50pm
;;7.0;OUTPATIENT PHARMACY;**635**;DEC 1997;Build 19
D F5245
Q
F5245 ;
N VAL,IEN,OLD,NEW
S VAL=0,VAL=$O(^PS(52.45,"C","ACR",VAL)) Q:'VAL D
.S IEN=0,IEN=$O(^PS(52.45,"C","ACR",VAL,IEN)) Q:'IEN D
..S OLD=$$GET1^DIQ(52.45,IEN,.02,"E")
..; only fix the ones that end with a space
..I $E(OLD,$L(OLD))'=" " Q
..S NEW=$E(OLD,1,$L(OLD)-1)
..S FDA(52.45,IEN_",",.02)=NEW
..D FILE^DIE(,"FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO635PO 472 printed Oct 16, 2024@18:24:07 Page 2
PSO635PO ;ALB/BWF^PSO*7*635 POST INIT ; 02/10/2021 1:50pm
+1 ;;7.0;OUTPATIENT PHARMACY;**635**;DEC 1997;Build 19
+2 DO F5245
+3 QUIT
F5245 ;
+1 NEW VAL,IEN,OLD,NEW
+2 SET VAL=0
SET VAL=$ORDER(^PS(52.45,"C","ACR",VAL))
if 'VAL
QUIT
Begin DoDot:1
+3 SET IEN=0
SET IEN=$ORDER(^PS(52.45,"C","ACR",VAL,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET OLD=$$GET1^DIQ(52.45,IEN,.02,"E")
+5 ; only fix the ones that end with a space
+6 IF $EXTRACT(OLD,$LENGTH(OLD))'=" "
QUIT
+7 SET NEW=$EXTRACT(OLD,1,$LENGTH(OLD)-1)
+8 SET FDA(52.45,IEN_",",.02)=NEW
+9 DO FILE^DIE(,"FDA")
End DoDot:2
End DoDot:1
+10 QUIT
