LRAPBRPW.m

LRAPBRPW ;VA/DALOI/WTY - POW Patient Browser Print;04/03/01

 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

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

 ;

MAIN ;Main subroutine

 N LRTEXT

 D:$$GET1^DIQ(2,DFN_",",.525,"I")="Y" POW

 D:$$GET1^DIQ(2,DFN_",",.32201,"I")="Y" PERSGULF

 Q

POW ;Prisoner-of-War text

 N LRCLOC

 D GLENTRY("","",1)

 S LRTEXT="*** THIS PATIENT WAS A PRISONER OF WAR ***"

 D GLENTRY(LRTEXT,19,1)

 F I=1:1:2 D GLENTRY("","",1)

 S LRCLOC=$$GET1^DIQ(2,DFN_",",".526:.01")

 D:LRCLOC'="" GLENTRY("POW PERIOD: "_LRCLOC,24)

 D GLENTRY("","",1)

 S LRTEXT="FORWARD A DUPLICATE SET OF SLIDES, BLOCKS AND REPRESENTATIVE "

 S LRTEXT=LRTEXT_"WET TISSUE TO:"

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 D GLENTRY("DIRECTOR,ARMED FORCES INSTITUTE OF PATHOLOGY",3,1)

 D GLENTRY("ATTENTION: FORMER POW REGISTRY",3,1)

 D GLENTRY("WASHINGTON, D.C. 20306",3,1)

 S LRTEXT="<A POW label (VA Form 10-5558) may be attached to packaged "

 S LRTEXT=LRTEXT_"specimens>"

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 D GLENTRY("MARK CASE CLEARLY AS:  FORMER POW  "_LRCLOC,"",1)

 S LRTEXT="NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE "

 S LRTEXT=LRTEXT_"AFIP"

 D GLENTRY(LRTEXT,"",1)

 I $D(LRSS),LRSS="AU" D AUNOTE

 F I=1:1:2 D GLENTRY("","",1)

 Q

AUNOTE ;Autopsy text

 D GLENTRY("","",1)

 S LRTEXT="Follow Guidelines for Performing Autopsy Examination on "

 S LRTEXT=LRTEXT_"Former Prisoners of War (POW's)  PROFESSIONAL "

 S LRTEXT=LRTEXT_"SERVICES LETTER  IL 11-82-17"

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("Be sure to take appropriate samples of:","",1)

 S LRTEXT="BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"

 D GLENTRY(LRTEXT,"",1)

 Q

PERSGULF ;Persian Gulf text

 S LRTEXT="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"

 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

 D GLENTRY("","",1)

 D GLENTRY(LRTEXT,"",1)

 F I=1:1:2 D GLENTRY("","",1)

 S LRTEXT=$$CJ^XLFSTR("***************",IOM)

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 S LRTEXT="Send a set of DUPLICATE paraffin blocks/smears, "

 S LRTEXT=LRTEXT_"H & E slides for "

 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 S LRTEXT="Anatomic Path material and a copy of the Final Pathology "

 S LRTEXT=LRTEXT_"Report to "

 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 S LRTEXT=$$CJ^XLFSTR("the AFIP using the AFIP Requisition form.  ",IOM)

 D GLENTRY(LRTEXT,"",1)

 F I=1:1:2 D GLENTRY("","",1)

 S LRTEXT=$$CJ^XLFSTR("***************",IOM)

 D GLENTRY(LRTEXT,"",1)

 D GLENTRY("","",1)

 Q

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 an current line.

 S LRPR3=+$G(LRPR3)

 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)

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

 Q

LRAPBRPW  ;VA/DALOI/WTY - POW Patient Browser Print;04/03/01

 +1       ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

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

 +3       ;

MAIN      ;Main subroutine

 +1        NEW LRTEXT

 +2        IF $$GET1^DIQ(2,DFN_",",.525,"I")="Y"

               DO POW

 +3        IF $$GET1^DIQ(2,DFN_",",.32201,"I")="Y"

               DO PERSGULF

 +4        QUIT 

POW       ;Prisoner-of-War text

 +1        NEW LRCLOC

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

 +3        SET LRTEXT="*** THIS PATIENT WAS A PRISONER OF WAR ***"

 +4        DO GLENTRY(LRTEXT,19,1)

 +5        FOR I=1:1:2

               DO GLENTRY("","",1)

 +6        SET LRCLOC=$$GET1^DIQ(2,DFN_",",".526:.01")

 +7        IF LRCLOC'=""

               DO GLENTRY("POW PERIOD: "_LRCLOC,24)

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

 +9        SET LRTEXT="FORWARD A DUPLICATE SET OF SLIDES, BLOCKS AND REPRESENTATIVE "

 +10       SET LRTEXT=LRTEXT_"WET TISSUE TO:"

 +11       DO GLENTRY(LRTEXT,"",1)

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

 +13       DO GLENTRY("DIRECTOR,ARMED FORCES INSTITUTE OF PATHOLOGY",3,1)

 +14       DO GLENTRY("ATTENTION: FORMER POW REGISTRY",3,1)

 +15       DO GLENTRY("WASHINGTON, D.C. 20306",3,1)

 +16       SET LRTEXT="<A POW label (VA Form 10-5558) may be attached to packaged "

 +17       SET LRTEXT=LRTEXT_"specimens>"

 +18       DO GLENTRY(LRTEXT,"",1)

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

 +20       DO GLENTRY("MARK CASE CLEARLY AS:  FORMER POW  "_LRCLOC,"",1)

 +21       SET LRTEXT="NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE "

 +22       SET LRTEXT=LRTEXT_"AFIP"

 +23       DO GLENTRY(LRTEXT,"",1)

 +24       IF $DATA(LRSS)

               IF LRSS="AU"

                   DO AUNOTE

 +25       FOR I=1:1:2

               DO GLENTRY("","",1)

 +26       QUIT 

AUNOTE    ;Autopsy text

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

 +2        SET LRTEXT="Follow Guidelines for Performing Autopsy Examination on "

 +3        SET LRTEXT=LRTEXT_"Former Prisoners of War (POW's)  PROFESSIONAL "

 +4        SET LRTEXT=LRTEXT_"SERVICES LETTER  IL 11-82-17"

 +5        DO GLENTRY(LRTEXT,"",1)

 +6        DO GLENTRY("Be sure to take appropriate samples of:","",1)

 +7        SET LRTEXT="BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"

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

 +9        QUIT 

PERSGULF  ;Persian Gulf text

 +1        SET LRTEXT="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"

 +2        SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

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

 +4        DO GLENTRY(LRTEXT,"",1)

 +5        FOR I=1:1:2

               DO GLENTRY("","",1)

 +6        SET LRTEXT=$$CJ^XLFSTR("***************",IOM)

 +7        DO GLENTRY(LRTEXT,"",1)

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

 +9        SET LRTEXT="Send a set of DUPLICATE paraffin blocks/smears, "

 +10       SET LRTEXT=LRTEXT_"H & E slides for "

 +11       SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

 +12       DO GLENTRY(LRTEXT,"",1)

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

 +14       SET LRTEXT="Anatomic Path material and a copy of the Final Pathology "

 +15       SET LRTEXT=LRTEXT_"Report to "

 +16       SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)

 +17       DO GLENTRY(LRTEXT,"",1)

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

 +19       SET LRTEXT=$$CJ^XLFSTR("the AFIP using the AFIP Requisition form.  ",IOM)

 +20       DO GLENTRY(LRTEXT,"",1)

 +21       FOR I=1:1:2

               DO GLENTRY("","",1)

 +22       SET LRTEXT=$$CJ^XLFSTR("***************",IOM)

 +23       DO GLENTRY(LRTEXT,"",1)

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

 +25       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 an current line.

 +4        SET LRPR3=+$GET(LRPR3)

 +5        IF LRPR3

               DO NEWLN^LRAPUTL(LRPR1,LRPR2)

 +6        IF 'LRPR3

               DO GLBWRT^LRAPUTL(LRPR1,LRPR2)

 +7        QUIT