Routine: LRAPBR3

LRAPBR3 ;DALOI/WTY - AP Browser Print Cont.;04/06/01

 ;;5.2;LAB SERVICE;**259,413**;Sep 27, 1994;Build 2

 ; This routine was created from LRSPRPT1 to be used for printing

 ; the SF515 to the browser and storing the report in a global format

 ; This routine displays any special studies.  Printing of SNOMED

 ; codes and associated journal references (if any) has been removed.

MAIN ;

 N LRTP,LRCNT1,LRA1,LRFILE,LRFILE1

 N LRIENS1,LRA2

 Q:$G(LRSF)=""

 S LRA1=0,LRIENS=LRI_","_LRDFN_","

 S LRFILE=+$$GET1^DID(LRSF,10,"","SPECIFIER")

 F  S LRA1=$O(^LR(LRDFN,LRSS,LRI,2,LRA1)) Q:'LRA1  D

 .S LRIENS1=LRA1_","_LRIENS

 .S LRTP(1)=$$GET1^DIQ(LRFILE,LRIENS1,.01)

 .S LRTP(2)=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")

 .S LRTP(8)=$$GET1^DIQ(LRFILE,LRIENS1,".01:2")

 .D SPCSTD

 .D JRNLREF

SPCSTD ;Display Special Studies

 Q:'$P($G(^LR(LRDFN,LRSS,LRI,2,LRA1,5,0)),"^",4)

 D GLENTRY("SPECIAL STUDIES:","",1)

 N LRX,DIWR,DIWL,LRC,LRTMP

 S LRC=0 F  S LRC=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,5,LRC)) Q:'LRC  D

 .S LRFILE1=+$$GET1^DID(LRFILE,5,"","SPECIFIER")

 .F I=.01:.01:.03 D

 ..S LRTP(I)=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,I)

 .D GLENTRY("","",1)

 .D GLENTRY(LRTP(.01)_" "_LRTP(.03)_" Date: "_LRTP(.02),"",1)

 .D GLENTRY(LRTP(1),"",1)

 .K ^UTILITY($J,"W")

 .S LRX=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,1,"","LRTMP")

 .S DIWR=IOM-10,DIWL=10,DIWF=""

 .S LRX=+$$GET1^DID(LRFILE1,1,"","SPECIFIER")

 .I $$GET1^DID(LRX,.01,"","SPECIFIER")["L" S DIWF="N"

 .S LRA2=0 F  S LRA2=$O(LRTMP(LRA2)) Q:'LRA2  S X=LRTMP(LRA2) D ^DIWP

 .S LRA2=0 F  S LRA2=$O(^UTILITY($J,"W",DIWL,LRA2)) Q:'LRA2  D

 ..D GLENTRY(^UTILITY($J,"W",DIWL,LRA2,0),DIWL,1)

 .K ^UTILITY($J,"W")

JRNLREF ;Display Journal References

 ;Topography

 N LRFL,LRM,LRN

 S LRFL=LRTP(2),LRFILE1=61 D JREFPRT

 ;Morphology

 S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")

 S LRM=0 F  S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM)) Q:'LRM  D

 .S LRIENS2=LRM_","_LRIENS1

 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 .D JREFPRT

 .;Etiology

 .S LRFILE1=61.2,LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")

 .S LRN=0 F  S LRN=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM,1,LRN)) Q:'LRN  D

 ..S LRIENS3=LRN_","_LRIENS2

 ..S LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")

 ..D JREFPRT

 ;Disease

 S LRFILE1=61.4,LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")

 S LRM=0 F  S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,1,LRM)) Q:'LRM  D

 .S LRIENS2=LRM_","_LRIENS1

 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 .D JREFPRT

 ;Function

 S LRFILE1=61.3,LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")

 S LRM=0 F  S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,3,LRM)) Q:'LRM  D

 .S LRIENS2=LRM_","_LRIENS1

 .S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 .D JREFPRT

JREFPRT ;

 ; Print journal reference on the patient report if the

 ; reference is flagged for printing.

 N LRJR,LRINC

 S LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")

 S LRJR=0 F  S LRJR=$O(^LAB(LRFILE1,LRFL,"JR",LRJR)) Q:'LRJR  D

 .S LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)

 .F LRINC=1:1:5 D

 ..S LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)

 .S LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")

 .Q:'LRJR(6)

 .D GLENTRY(,,1),GLENTRY("Reference: ",,1)

 .D GLENTRY(LRJR(.01),,1)

 .D GLENTRY(LRJR(1),,1),GLENTRY(,,1)

 .I LRJR(2)'="" D

 ..D GLENTRY(LRJR(2)_"  vol."_LRJR(3),BTAB)

 ..D GLENTRY(" pg."_LRJR(4),BTAB)

 .D GLENTRY("  Date: "_LRJR(5),BTAB)

GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global

 ;LRPR1 = Text to be written to global

 ;LRPR2 = Tab position

 ;LRPR3 = 1 means start a new line.  Othewise, write on current line.

 S LRPR1=$G(LRPR1),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)

 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)

 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPBR3   3726     printed  Feb 18, 2025@23:32:55                                                                                                                                                                                                     Page 2

LRAPBR3   ;DALOI/WTY - AP Browser Print Cont.;04/06/01

 +1       ;;5.2;LAB SERVICE;**259,413**;Sep 27, 1994;Build 2

 +2       ;

 +3       ; This routine was created from LRSPRPT1 to be used for printing

 +4       ; the SF515 to the browser and storing the report in a global format

 +5       ; This routine displays any special studies.  Printing of SNOMED

 +6       ; codes and associated journal references (if any) has been removed.

MAIN      ;

 +1        NEW LRTP,LRCNT1,LRA1,LRFILE,LRFILE1

 +2        NEW LRIENS1,LRA2

 +3        if $GET(LRSF)=""

               QUIT

 +4        SET LRA1=0

           SET LRIENS=LRI_","_LRDFN_","

 +5        SET LRFILE=+$$GET1^DID(LRSF,10,"","SPECIFIER")

 +6        FOR

               SET LRA1=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1))

               if 'LRA1

                   QUIT

               Begin DoDot:1

 +7                SET LRIENS1=LRA1_","_LRIENS

 +8                SET LRTP(1)=$$GET1^DIQ(LRFILE,LRIENS1,.01)

 +9                SET LRTP(2)=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")

 +10               SET LRTP(8)=$$GET1^DIQ(LRFILE,LRIENS1,".01:2")

 +11               DO SPCSTD

 +12               DO JRNLREF

               End DoDot:1

 +13       QUIT

SPCSTD    ;Display Special Studies

 +1        if '$PIECE($GET(^LR(LRDFN,LRSS,LRI,2,LRA1,5,0)),"^",4)

               QUIT

 +2        DO GLENTRY("SPECIAL STUDIES:","",1)

 +3        NEW LRX,DIWR,DIWL,LRC,LRTMP

 +4        SET LRC=0

FOR

               SET LRC=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,5,LRC))

               if 'LRC

                   QUIT

               Begin DoDot:1

 +5                SET LRFILE1=+$$GET1^DID(LRFILE,5,"","SPECIFIER")

 +6                FOR I=.01:.01:.03

                       Begin DoDot:2

 +7                        SET LRTP(I)=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,I)

                       End DoDot:2

 +8                DO GLENTRY("","",1)

 +9                DO GLENTRY(LRTP(.01)_" "_LRTP(.03)_" Date: "_LRTP(.02),"",1)

 +10               DO GLENTRY(LRTP(1),"",1)

 +11               KILL ^UTILITY($JOB,"W")

 +12               SET LRX=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,1,"","LRTMP")

 +13               SET DIWR=IOM-10

                   SET DIWL=10

                   SET DIWF=""

 +14               SET LRX=+$$GET1^DID(LRFILE1,1,"","SPECIFIER")

 +15               IF $$GET1^DID(LRX,.01,"","SPECIFIER")["L"

                       SET DIWF="N"

 +16               SET LRA2=0

FOR

                       SET LRA2=$ORDER(LRTMP(LRA2))

                       if 'LRA2

                           QUIT

                       SET X=LRTMP(LRA2)

                       DO ^DIWP

 +17               SET LRA2=0

FOR

                       SET LRA2=$ORDER(^UTILITY($JOB,"W",DIWL,LRA2))

                       if 'LRA2

                           QUIT

                       Begin DoDot:2

 +18                       DO GLENTRY(^UTILITY($JOB,"W",DIWL,LRA2,0),DIWL,1)

                       End DoDot:2

 +19               KILL ^UTILITY($JOB,"W")

               End DoDot:1

 +20       QUIT

 +21      ;

JRNLREF   ;Display Journal References

 +1       ;Topography

 +2        NEW LRFL,LRM,LRN

 +3        SET LRFL=LRTP(2)

           SET LRFILE1=61

           DO JREFPRT

 +4       ;Morphology

 +5        SET LRFILE1=61.1

           SET LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")

 +6        SET LRM=0

FOR

               SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM))

               if 'LRM

                   QUIT

               Begin DoDot:1

 +7                SET LRIENS2=LRM_","_LRIENS1

 +8                SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 +9                DO JREFPRT

 +10      ;Etiology

 +11               SET LRFILE1=61.2

                   SET LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")

 +12               SET LRN=0

FOR

                       SET LRN=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM,1,LRN))

                       if 'LRN

                           QUIT

                       Begin DoDot:2

 +13                       SET LRIENS3=LRN_","_LRIENS2

 +14                       SET LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")

 +15                       DO JREFPRT

                       End DoDot:2

               End DoDot:1

 +16      ;Disease

 +17       SET LRFILE1=61.4

           SET LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")

 +18       SET LRM=0

FOR

               SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,1,LRM))

               if 'LRM

                   QUIT

               Begin DoDot:1

 +19               SET LRIENS2=LRM_","_LRIENS1

 +20               SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 +21               DO JREFPRT

               End DoDot:1

 +22      ;Function

 +23       SET LRFILE1=61.3

           SET LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")

 +24       SET LRM=0

FOR

               SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,3,LRM))

               if 'LRM

                   QUIT

               Begin DoDot:1

 +25               SET LRIENS2=LRM_","_LRIENS1

 +26               SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")

 +27               DO JREFPRT

               End DoDot:1

 +28       QUIT

JREFPRT   ;

 +1       ; Print journal reference on the patient report if the

 +2       ; reference is flagged for printing.

 +3        NEW LRJR,LRINC

 +4        SET LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")

 +5        SET LRJR=0

FOR

               SET LRJR=$ORDER(^LAB(LRFILE1,LRFL,"JR",LRJR))

               if 'LRJR

                   QUIT

               Begin DoDot:1

 +6                SET LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)

 +7                FOR LRINC=1:1:5

                       Begin DoDot:2

 +8                        SET LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)

                       End DoDot:2

 +9                SET LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")

 +10               if 'LRJR(6)

                       QUIT

 +11               DO GLENTRY(,,1)

                   DO GLENTRY("Reference: ",,1)

 +12               DO GLENTRY(LRJR(.01),,1)

 +13               DO GLENTRY(LRJR(1),,1)

                   DO GLENTRY(,,1)

 +14               IF LRJR(2)'=""

                       Begin DoDot:2

 +15                       DO GLENTRY(LRJR(2)_"  vol."_LRJR(3),BTAB)

 +16                       DO GLENTRY(" pg."_LRJR(4),BTAB)

                       End DoDot:2

 +17               DO GLENTRY("  Date: "_LRJR(5),BTAB)

               End DoDot:1

 +18       QUIT

GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global

 +1       ;LRPR1 = Text to be written to global

 +2       ;LRPR2 = Tab position

 +3       ;LRPR3 = 1 means start a new line.  Othewise, write on current line.

 +4        SET LRPR1=$GET(LRPR1)

           SET LRPR2=+$GET(LRPR2)

           SET LRPR3=+$GET(LRPR3)

 +5        if LRPR3

               DO NEWLN^LRAPUTL(LRPR1,LRPR2)

 +6        if 'LRPR3

               DO GLBWRT^LRAPUTL(LRPR1,LRPR2)

 +7        QUIT

LRAPBR3.m