PSO635PO.m

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 ---PSO635PO   472     printed  Apr 09, 2024@21:33:13                                                                                                                                                                                                     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