Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRACFILE

LRACFILE.m

Go to the documentation of this file.
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