- LRACFILE ; IHS/DIR/FJE - SORT FILE ROOM PATIENTS BY SSN 6/2/87 11:30 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;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:$D(^LR(LRDFN,0))[0 S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX S HRCN=" "_HRCN_" ",LRNM=F D PAT1^LRAC1 ;IHS/ANMC/CLS 11/1/95
- 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
- F Q=0:0 S F1=$O(^TMP($J,"HRCN",F,F1)) Q:F1="" S 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
- S F="" F Q=0:0 S F=$O(^TMP($J,"HRCN",F)) Q:F="" S F1="" D F1 ;IHS/ANMC/CLS 11/1/95
- ;K F1,F,^TMP($J,"SSN") Q
- K F1,F,^TMP($J,"HRCN") Q ;IHS/ANMC/CLS 11/1/95
- LRACFILE ; IHS/DIR/FJE - SORT FILE ROOM PATIENTS BY SSN 6/2/87 11:30 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;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
- +1 ;IHS/ANMC/CLS 11/1/95
- 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 HRCN=" "_HRCN_" "
- SET LRNM=F
- DO PAT1^LRAC1
- +2 QUIT
- 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
- +1 FOR Q=0:0
- SET F1=$ORDER(^TMP($JOB,"HRCN",F,F1))
- IF F1=""
- QUIT
- SET LRDFN=F1
- DO F2
- +2 QUIT
- ENT ;from LRAC1
- +1 ;S F="" F Q=0:0 S F=$O(^TMP($J,"SSN",F)) Q:F="" S F1="" D F1
- +2 ;IHS/ANMC/CLS 11/1/95
- SET F=""
- FOR Q=0:0
- SET F=$ORDER(^TMP($JOB,"HRCN",F))
- IF F=""
- QUIT
- SET F1=""
- DO F1
- +3 ;K F1,F,^TMP($J,"SSN") Q
- +4 ;IHS/ANMC/CLS 11/1/95
- KILL F1,F,^TMP($JOB,"HRCN")
- QUIT
