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 ---[H[J[2J[HLRACFILE 447 printed Dec 13, 2024@02:06:17 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
