LRACFILE.m

LRACFILE ;SLC/DCM - SORT FILE ROOM PATIENTS BY SSN ; 6/2/87  11:30 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

F2 Q:$D(^LR(LRDFN,0))[0  S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX S SSN=" "_SSN_" ",LRNM=F D PAT1^LRAC1

 Q

F1 F Q=0:0 S F1=$O(^TMP($J,"SSN",F,F1)) Q:F1=""  S SSN=$E(F,6,8)_"-"_$E(F,9,10)_"-"_$E(F,1,5),LRDFN=F1 D F2

 Q

ENT ;from LRAC1

 S F="" F Q=0:0 S F=$O(^TMP($J,"SSN",F)) Q:F=""  S F1="" D F1

 K F1,F,^TMP($J,"SSN") Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRACFILE   447     printed  Apr 09, 2024@21:20:10                                                                                                                                                                                                     Page 2

LRACFILE  ;SLC/DCM - SORT FILE ROOM PATIENTS BY SSN ; 6/2/87  11:30 ;

 +1       ;;5.2;LAB SERVICE;;Sep 27, 1994

F2         if $DATA(^LR(LRDFN,0))[0

               QUIT 

           SET DFN=$PIECE(^LR(LRDFN,0),U,3)

           SET LRDPF=+$PIECE(^(0),U,2)

           DO PT^LRX

           SET SSN=" "_SSN_" "

           SET LRNM=F

           DO PAT1^LRAC1

 +1        QUIT 

F1         FOR Q=0:0

               SET F1=$ORDER(^TMP($JOB,"SSN",F,F1))

               if F1=""

                   QUIT 

               SET SSN=$EXTRACT(F,6,8)_"-"_$EXTRACT(F,9,10)_"-"_$EXTRACT(F,1,5)

               SET LRDFN=F1

               DO F2

 +1        QUIT 

ENT       ;from LRAC1

 +1        SET F=""

           FOR Q=0:0

               SET F=$ORDER(^TMP($JOB,"SSN",F))

               if F=""

                   QUIT 

               SET F1=""

               DO F1

 +2        KILL F1,F,^TMP($JOB,"SSN")

           QUIT