LRQC.m

LRQC ; IHS/DIR/AAB - QUALITY CONTROL DISPLAY 6/2/86 8:38 AM ;  [ 07/22/2002  1:37 PM ]

 ;;5.2;LR;**1006,1013**;JUL 15, 2002

 ;

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

 D DT^LRX D EN^LRPARAM

 S LRDT0=$$Y2K^LRX(DT)

 S DIC="^LAB(62.3,",DIC(0)="AEQZ" D ^DIC G END:Y<1 S DFN=+Y,LRDFN=+$G(^LAB(62.3,DFN,"LR")) G END:'LRDFN S LRDPF=62.3

 S PNM=$P(Y(0),U),SSN=$P(Y(0),U,9) D PT^LRX

 K DIC D ENT^LRDIST

END ;K SEX,S1,J,T,LRMX,POP,AGE,DFN,DIC,DOB,LRDFN,LRDPF,SSN

 K SEX,S1,J,T,LRMX,POP,AGE,DFN,DIC,DOB,LRDFN,LRDPF,SSN,HRCN  ;IHS/ANMC/CLS 08/18/96

 Q

LRQC      ; IHS/DIR/AAB - QUALITY CONTROL DISPLAY 6/2/86 8:38 AM ;  [ 07/22/2002  1:37 PM ]

 +1       ;;5.2;LR;**1006,1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;**201**;Sep 27, 1994

 +4        DO DT^LRX

           DO EN^LRPARAM

 +5        SET LRDT0=$$Y2K^LRX(DT)

 +6        SET DIC="^LAB(62.3,"

           SET DIC(0)="AEQZ"

           DO ^DIC

           IF Y<1

               GOTO END

           SET DFN=+Y

           SET LRDFN=+$GET(^LAB(62.3,DFN,"LR"))

           IF 'LRDFN

               GOTO END

           SET LRDPF=62.3

 +7        SET PNM=$PIECE(Y(0),U)

           SET SSN=$PIECE(Y(0),U,9)

           DO PT^LRX

 +8        KILL DIC

           DO ENT^LRDIST

END       ;K SEX,S1,J,T,LRMX,POP,AGE,DFN,DIC,DOB,LRDFN,LRDPF,SSN

 +1       ;IHS/ANMC/CLS 08/18/96

           KILL SEX,S1,J,T,LRMX,POP,AGE,DFN,DIC,DOB,LRDFN,LRDPF,SSN,HRCN

 +2        QUIT