BLRESRCD.m

BLRESRCD ; IHS/OIT/MKK - Laboratory E-SIG Reports: Compile Data ; [ 04/12/06  4:00 PM ]

 ;;5.2;LR;**1022**;September 20, 2007

 ;

 ; NOTE:  The LRIDT variable in the LR("BLRA") index is stored as

 ;        as a negative number.  That is why, in several places,

 ;        the code does -(LRIDT).

 ;

EP ; "Ersatz" EP

 W $C(7),$C(7),$C(7),!

 W "Use Label Only",!

 W $C(7),$C(7),$C(7),!

 Q

 ;

 ; Get E-SIG Data, Part 1

GETESIGD ; EP

 S NRESP=$P($G(^VA(200,ESPHY,0)),"^",1)    ; Resp Phy Name

 S BLRESIGR(NRESP)=ESPHY

 ;

 S STATUS=""           ; E-SIG Status

 F  S STATUS=$O(^LR("BLRA",ESPHY,STATUS))  Q:STATUS=""  D

 . D GETESIG2

 Q

 ;

 ; Get E-SIG data, Part 2

GETESIG2 ; EP

 S LRIDT=""           ; Inverse Date

 F  S LRIDT=$O(^LR("BLRA",ESPHY,STATUS,LRIDT))  Q:LRIDT=""  D

 . I LRIDT<BEGIDT!(LRIDT>ENDIDT) Q    ; Date must be in range

 . ;

 . S LRDFN=0           ; Patient Lab Reference Number

 . S LRDFN=$O(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN))  Q:LRDFN=""  D

 .. S LRAA=""          ; Accession Area

 .. F  S LRAA=$O(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN,LRAA))  Q:LRAA=""  D

 ... S BLRESIGR=$G(^LR(LRDFN,LRAA,-(LRIDT),9009027)) ; E-SIG String

 ... I $G(BLRESIGR)="" Q                    ; If Null, skip

 ... ;

 ... ; Patient Name

 ... S PATN=$P($G(^DPT($P($G(^LR(LRDFN,0)),"^",3),0)),"^",1)

 ... ;

 ... S BLRESIGR(NRESP,PATN,LRAA,LRDFN,-(LRIDT))=""

 Q

 ;

 ; Not Signed by Responsible Physician

NSIGNTXN ; EP

 S LRIDT=""

 F  S LRIDT=$O(^LR("BLRA",ESPHY,STATUS,LRIDT))  Q:LRIDT=""  D

 . I LRIDT<BEGIDT!(LRIDT>ENDIDT) Q    ; Date must be in range

 . ;

 . S LRDFN=0

 . S LRDFN=$O(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN))  Q:LRDFN=""  D

 .. S LRAA=""

 .. F  S LRAA=$O(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN,LRAA))  Q:LRAA=""  D

 ... S BLRESIGR=$G(^LR(LRDFN,LRAA,-(LRIDT),9009027)) ; E-SIG String

 ... I $G(BLRESIGR)="" Q

 ... I $P(BLRESIGR,"^",3)=ESPHY Q      ; If Responsible = Signing Phy, skip

 ... ;

 ... S PATN=$P($G(^DPT($P($G(^LR(LRDFN,0)),"^",3),0)),"^",1)

 ... ;

 ... S BLRESIGR(NRESP,PATN,LRAA,LRDFN,-(LRIDT))=""

 ... S CNT=CNT+1

 Q

BLRESRCD  ; IHS/OIT/MKK - Laboratory E-SIG Reports: Compile Data ; [ 04/12/06  4:00 PM ]

 +1       ;;5.2;LR;**1022**;September 20, 2007

 +2       ;

 +3       ; NOTE:  The LRIDT variable in the LR("BLRA") index is stored as

 +4       ;        as a negative number.  That is why, in several places,

 +5       ;        the code does -(LRIDT).

 +6       ;

EP        ; "Ersatz" EP

 +1        WRITE $CHAR(7),$CHAR(7),$CHAR(7),!

 +2        WRITE "Use Label Only",!

 +3        WRITE $CHAR(7),$CHAR(7),$CHAR(7),!

 +4        QUIT 

 +5       ;

 +6       ; Get E-SIG Data, Part 1

GETESIGD  ; EP

 +1       ; Resp Phy Name

           SET NRESP=$PIECE($GET(^VA(200,ESPHY,0)),"^",1)

 +2        SET BLRESIGR(NRESP)=ESPHY

 +3       ;

 +4       ; E-SIG Status

           SET STATUS=""

 +5        FOR 

               SET STATUS=$ORDER(^LR("BLRA",ESPHY,STATUS))

               IF STATUS=""

                   QUIT 

               Begin DoDot:1

 +6                DO GETESIG2

               End DoDot:1

 +7        QUIT 

 +8       ;

 +9       ; Get E-SIG data, Part 2

GETESIG2  ; EP

 +1       ; Inverse Date

           SET LRIDT=""

 +2        FOR 

               SET LRIDT=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT))

               IF LRIDT=""

                   QUIT 

               Begin DoDot:1

 +3       ; Date must be in range

                   IF LRIDT<BEGIDT!(LRIDT>ENDIDT)

                       QUIT 

 +4       ;

 +5       ; Patient Lab Reference Number

                   SET LRDFN=0

 +6                SET LRDFN=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN))

                   IF LRDFN=""

                       QUIT 

                   Begin DoDot:2

 +7       ; Accession Area

                       SET LRAA=""

 +8                    FOR 

                           SET LRAA=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN,LRAA))

                           IF LRAA=""

                               QUIT 

                           Begin DoDot:3

 +9       ; E-SIG String

                               SET BLRESIGR=$GET(^LR(LRDFN,LRAA,-(LRIDT),9009027))

 +10      ; If Null, skip

                               IF $GET(BLRESIGR)=""

                                   QUIT 

 +11      ;

 +12      ; Patient Name

 +13                           SET PATN=$PIECE($GET(^DPT($PIECE($GET(^LR(LRDFN,0)),"^",3),0)),"^",1)

 +14      ;

 +15                           SET BLRESIGR(NRESP,PATN,LRAA,LRDFN,-(LRIDT))=""

                           End DoDot:3

                   End DoDot:2

               End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ; Not Signed by Responsible Physician

NSIGNTXN  ; EP

 +1        SET LRIDT=""

 +2        FOR 

               SET LRIDT=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT))

               IF LRIDT=""

                   QUIT 

               Begin DoDot:1

 +3       ; Date must be in range

                   IF LRIDT<BEGIDT!(LRIDT>ENDIDT)

                       QUIT 

 +4       ;

 +5                SET LRDFN=0

 +6                SET LRDFN=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN))

                   IF LRDFN=""

                       QUIT 

                   Begin DoDot:2

 +7                    SET LRAA=""

 +8                    FOR 

                           SET LRAA=$ORDER(^LR("BLRA",ESPHY,STATUS,LRIDT,LRDFN,LRAA))

                           IF LRAA=""

                               QUIT 

                           Begin DoDot:3

 +9       ; E-SIG String

                               SET BLRESIGR=$GET(^LR(LRDFN,LRAA,-(LRIDT),9009027))

 +10                           IF $GET(BLRESIGR)=""

                                   QUIT 

 +11      ; If Responsible = Signing Phy, skip

                               IF $PIECE(BLRESIGR,"^",3)=ESPHY

                                   QUIT 

 +12      ;

 +13                           SET PATN=$PIECE($GET(^DPT($PIECE($GET(^LR(LRDFN,0)),"^",3),0)),"^",1)

 +14      ;

 +15                           SET BLRESIGR(NRESP,PATN,LRAA,LRDFN,-(LRIDT))=""

 +16                           SET CNT=CNT+1

                           End DoDot:3

                   End DoDot:2

               End DoDot:1

 +17       QUIT