RAORD61.m

RAORD61 ;HISC/GJC-Print A Request Cont. ;2/2/98  15:28

 ;;5.0;Radiology/Nuclear Medicine;**45,68,47**;Mar 16, 1998;Build 21

 ;11/18/05 KAM Remedy Call 100930 Remove extra dash lines

 ;

TC ;technologist information & comment (called from RAORD6)

 N RA18FL,RA18ARR,RA18EX,RA18CNI,RA18DTI,RA18PRC,RA18ND,RA18TC S RA18EX=0,RA18CNI=0

 ;11/18/05 KAM Modified next line - was G:RA18DTI="" DASHLN^RAORD6

 S RA18DTI=$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:RA18DTI=""

 F  S RA18CNI=$O(^TMP($J,"RAE2",RADFN,RA18CNI)) Q:+RA18CNI=0  D  Q:RAX["^"

 . S RA18PRC=""

 . F  S RA18PRC=$O(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC)) Q:RA18PRC=""  D  Q:RAX["^"

 .. ;case info

 .. I $$USESSAN^RAHLRU1() W !,"Case No: "_$P($G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,0)),"^",31),!

 .. I '$$USESSAN^RAHLRU1() W !,"Case No: "_$P($G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,0)),"^")

 .. S RA18FL=0,RA18ARR("FT")=""

 .. S RA18TC=0 F  S RA18TC=$O(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC)) Q:RA18TC=""  S RA18ARR("F")=$G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC,0),0) D  Q:$L(RA18ARR("FT"))>32

 ... I RA18ARR("F")'=0 S RA18ARR("FT")=RA18ARR("FT")_$P($G(RA18ARR("F")),"^",2)_"-"_$P($G(^RA(78.4,$P($G(RA18ARR("F")),"^",1),0)),"^",1)_";"

 .. S RA18TC=0 F  S RA18TC=$O(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC)) Q:RA18TC=""  S RA18ARR("T",RA18TC,0)=$G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC,0),0) D

 ... I RA18ARR("T",RA18TC,0)'=0 W:RA18FL>0 ! W ?14,"Tech: " I RA18ARR("T",RA18TC,0)'="" S RA18ARR("N")=$$GET1^DIQ(200,RA18ARR("T",RA18TC,0),.01) W $E($P(RA18ARR("N"),"^",1),1,18)

 ... W:(RA18FL'>0) ?38,"  Film: "_$E(RA18ARR("FT"),1,32)

 ... S RA18FL=RA18FL+1

 .. I '$D(RA18ARR("T")) W ?14,"Tech: ",?38,"  Film: "_$E(RA18ARR("FT"),1,32)

 .. K RA18ARR("T"),RA18ARR("F"),RA18ARR("N")

 .. I $O(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",0))>0 D  Q

 ... ;tech comm

 ... W !

 ... S RA18EX=$$TXTOUT^RAUTL11(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",1),1,70,-1,"",4,1,1,1)

 ... D HD^RAORD6:($Y+6)>IOSL

 Q

 ;

RAORD61   ;HISC/GJC-Print A Request Cont. ;2/2/98  15:28

 +1       ;;5.0;Radiology/Nuclear Medicine;**45,68,47**;Mar 16, 1998;Build 21

 +2       ;11/18/05 KAM Remedy Call 100930 Remove extra dash lines

 +3       ;

TC        ;technologist information & comment (called from RAORD6)

 +1        NEW RA18FL,RA18ARR,RA18EX,RA18CNI,RA18DTI,RA18PRC,RA18ND,RA18TC

           SET RA18EX=0

           SET RA18CNI=0

 +2       ;11/18/05 KAM Modified next line - was G:RA18DTI="" DASHLN^RAORD6

 +3        SET RA18DTI=$ORDER(^RADPT("AO",RAOIFN,RADFN,0))

           IF RA18DTI=""

               QUIT 

 +4        FOR 

               SET RA18CNI=$ORDER(^TMP($JOB,"RAE2",RADFN,RA18CNI))

               IF +RA18CNI=0

                   QUIT 

               Begin DoDot:1

 +5                SET RA18PRC=""

 +6                FOR 

                       SET RA18PRC=$ORDER(^TMP($JOB,"RAE2",RADFN,RA18CNI,RA18PRC))

                       IF RA18PRC=""

                           QUIT 

                       Begin DoDot:2

 +7       ;case info

 +8                        IF $$USESSAN^RAHLRU1()

                               WRITE !,"Case No: "_$PIECE($GET(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,0)),"^",31),!

 +9                        IF '$$USESSAN^RAHLRU1()

                               WRITE !,"Case No: "_$PIECE($GET(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,0)),"^")

 +10                       SET RA18FL=0

                           SET RA18ARR("FT")=""

 +11                       SET RA18TC=0

                           FOR 

                               SET RA18TC=$ORDER(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC))

                               IF RA18TC=""

                                   QUIT 

                               SET RA18ARR("F")=$GET(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC,0),0)

                               Begin DoDot:3

 +12                               IF RA18ARR("F")'=0

                                       SET RA18ARR("FT")=RA18ARR("FT")_$PIECE($GET(RA18ARR("F")),"^",2)_"-"_$PIECE($GET(^RA(78.4,$PIECE($GET(RA18ARR("F")),"^",1),0)),"^",1)_";"

                               End DoDot:3

                               IF $LENGTH(RA18ARR("FT"))>32

                                   QUIT 

 +13                       SET RA18TC=0

                           FOR 

                               SET RA18TC=$ORDER(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC))

                               IF RA18TC=""

                                   QUIT 

                               SET RA18ARR("T",RA18TC,0)=$GET(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC,0),0)

                               Begin DoDot:3

 +14                               IF RA18ARR("T",RA18TC,0)'=0

                                       IF RA18FL>0

                                           WRITE !

                                       WRITE ?14,"Tech: "

                                       IF RA18ARR("T",RA18TC,0)'=""

                                           SET RA18ARR("N")=$$GET1^DIQ(200,RA18ARR("T",RA18TC,0),.01)

                                           WRITE $EXTRACT($PIECE(RA18ARR("N"),"^",1),1,18)

 +15                               IF (RA18FL'>0)

                                       WRITE ?38,"  Film: "_$EXTRACT(RA18ARR("FT"),1,32)

 +16                               SET RA18FL=RA18FL+1

                               End DoDot:3

 +17                       IF '$DATA(RA18ARR("T"))

                               WRITE ?14,"Tech: ",?38,"  Film: "_$EXTRACT(RA18ARR("FT"),1,32)

 +18                       KILL RA18ARR("T"),RA18ARR("F"),RA18ARR("N")

 +19                       IF $ORDER(^TMP($JOB,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",0))>0

                               Begin DoDot:3

 +20      ;tech comm

 +21                               WRITE !

 +22                               SET RA18EX=$$TXTOUT^RAUTL11(^TMP($JOB,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",1),1,70,-1,"",4,1,1,1)

 +23                               IF ($Y+6)>IOSL

                                       DO HD^RAORD6

                               End DoDot:3

                               QUIT 

                       End DoDot:2

                       IF RAX["^"

                           QUIT 

               End DoDot:1

               IF RAX["^"

                   QUIT 

 +24       QUIT 

 +25      ;