RACMP.m

RACMP ;HISC/GJC AISC/MJK-Complication Report (Part 1 of 3) ;4/16/96  09:47

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 ; Select Imaging Type, if exists

 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""

 N RACMP S RACMP=+$O(^RA(78.1,"B","NO COMPLICATION",0))

 I 'RACMP D  Q

 . W !,"You need to define 'NO COMPLICATION' in your Complication "

 . W "Types file",!,"in order to run this report!"

 . Q

 S X=$$DIVLOC^RAUTL7() I X D KILL Q

 S A="" F  S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']""  D

 . Q:'$D(^TMP($J,"RA D-TYPE",A))  S B=0

 . F  S B=+$O(^TMP($J,"RA D-TYPE",A,B)) Q:'B  D

 .. S ^TMP($J,"RACMP",B)=0

 .. S C="" F  S C=$O(RACCESS(DUZ,"DIV-IMG",A,C)) Q:C']""  D

 ... Q:'$D(^TMP($J,"RA I-TYPE",C))  S ^TMP($J,"RACMP",B,C)=0

 ... Q

 .. Q

 . Q

ASKLOG ; Ask date range

 K A,B,C,^TMP($J,"DIV-IMG") W !

 D DATE^RAUTL I RAPOP D KILL Q

 S RADTBEGI=BEGDATE,RADTENDI=ENDDATE

 S RADTBEG=BEGDATE-.0001,RADTEND=ENDDATE+.9999

 K BEGDATE,ENDDATE

 S Y=RADTBEGI X ^DD("DD") S RADTBEGX=Y

 S Y=RADTENDI X ^DD("DD") S RADTENDX=Y

 S ZTDESC="Rad/Nuc Med Complications Report"

 S ZTRTN="START^RACMP",ZTSAVE("RACMP")=""

 S ZTSAVE("RADT*")="",ZTSAVE("^TMP($J,""RACMP"",")=""

 S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""

 S ZTSAVE("^TMP($J,""RA I-TYPE"",")="" D ZIS^RAUTL

 I RAPOP D KILL Q

START ; Start processing data

 U IO D NOW^%DTC S (RAPG,RAXIT)=0

 S:$D(ZTQUEUED) ZTREQ="@"

 S RATDY=$$FMTE^XLFDT(%\1,1),$P(RALN,"-",(IOM+1))=""

 S RAERR="No Data Captured For This Time Frame."

 S RAHDR(1)=">>> Complications Report <<<"

 S RAHDR(2)="Period: "_RADTBEGX_" to "_RADTENDX_"."

 S RATAB(1)=$S(IOM=132:15,1:9),RATAB(2)=$S(IOM=132:24,1:26)

 S RATAB(3)=$S(IOM=132:40,1:34),RATAB(4)=$S(IOM=132:52,1:49)

 S RATAB(5)=$S(IOM=132:90,1:52),RATAB(6)=$S(IOM=132:102,1:62)

 F RADTE=RADTBEG:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE!(RADTE>RADTEND)  D  Q:RAXIT

 . S RADFN=0 F  S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN  D  Q:RAXIT

 .. S RADTI=9999999.9999-RADTE D SORT^RACMP2

 .. Q

 . Q

 I RAXIT D CLOSE^RAUTL,KILL Q

 S X=$O(^TMP($J,"RACMP",""))

 I X="" S Y=X

 E  S Y=$O(^TMP($J,"RACMP",X,""))

 S RADIV=X,RAITYPE=Y D HEADER^RACMP2

 I $D(^TMP($J,"RACMP")) D

 . D PRINT^RACMP1

 . I 'RAXIT D

 .. S RADIVNM=$$DIVTOT("RACMP") Q:'RADIVNM

 .. S (RADIV,RAFLG,RAITYPE)="",RAXIT=$$EOS^RAUTL5()

 .. I 'RAXIT D HEADER^RACMP2,SYNOP^RACMP2

 .. Q

 . Q

 D CLOSE^RAUTL,KILL

 Q

KILL ; Kill and quit

 K %,%I,RA0,RA1,RA10,RA2,RA3,RA4,RA5,RA7,RACCESS(DUZ,"DIV-IMG"),RACMPTX

 K RACNI,RACOMP,RADFN,RADIV,RADIVNM,RADTBEG,RADTBEGI,RADTBEGX,RADTE

 K RADTEND,RADTENDI,RADTENDX,RADTI,RAERR,RAEX,RAFLG,RAHDR,RAITYPE,RALN

 K RANME,RAPG,RAPHY,RAPOP,RAPRC,RARE,RARES,RASSN,RASTF,RATAB,RATDY,RATME

 K RAQUIT,RAXIT,X,Y,ZTDESC,ZTRTN,ZTSAVE

 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RACMP")

 K ^TMP($J,"RACMRE"),^TMP($J,"RACNTU"),^TMP($J,"RACOMP")

 K ^TMP($J,"RAEXAM")

 K:$D(RAPSTX) RACCESS,RAPSTX

 K %DT,BEGDATE,I,POP,RAMES

 Q

SET ; Set data global

 S X=RADTE D TIME^RAUTL1 S RATME=X

 S RAPRC=+$P(RAEX(0),"^",2),RAPRC=$G(^RAMIS(71,RAPRC,0))

 S RAPRC=$S($P(RAPRC,"^")]"":$E($P(RAPRC,"^"),1,20),1:"Unknown")

 S RARES=+$P(RAEX(0),"^",12),RARES=$G(^VA(200,RARES,0))

 S RARES=$S($P(RARES,"^")]"":$E($P(RARES,"^"),1,20),1:"Unknown")

 S RAPHY=+$P(RAEX(0),"^",14),RAPHY=$G(^VA(200,RAPHY,0))

 S RAPHY=$S($P(RAPHY,"^")]"":$E($P(RAPHY,"^"),1,20),1:"Unknown")

 S RASTF=+$P(RAEX(0),"^",15),RASTF=$G(^VA(200,RASTF,0))

 S RASTF=$S($P(RASTF,"^")]"":$E($P(RASTF,"^"),1,20),1:"Unknown")

 S RACMPTX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP"))

 S RACMPTX=$S(RACMPTX]"":RACMPTX,1:"None")

 S ^TMP($J,"RACMP",RADIV,RAITYPE,RANME,RADTE,RACNI)=RAPRC_"^"_RATME_"^"_RAPHY_"^"_RARES_"^"_RASTF_"^"_RACMPTX_"^"_$P(RACOMP,"^")_"^"_RASSN_"^"_RADFN

 Q

DIVTOT(Z) ; Check if more than one division is included in the report.

 ; Pass back '0' if just one division, '1' if more than one division.

 N X,Y1,Y2 S X=0

 S Y1=+$O(^TMP($J,Z,X)) Q:'Y1 0

 S Y2=+$O(^TMP($J,Z,Y1)) Q:Y2 1

 Q 0

RACMP     ;HISC/GJC AISC/MJK-Complication Report (Part 1 of 3) ;4/16/96  09:47

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 +2       ; Select Imaging Type, if exists

 +3        IF $ORDER(RACCESS(DUZ,""))=""

               DO SETVARS^RAPSET1(0)

               SET RAPSTX=""

 +4        NEW RACMP

           SET RACMP=+$ORDER(^RA(78.1,"B","NO COMPLICATION",0))

 +5        IF 'RACMP

               Begin DoDot:1

 +6                WRITE !,"You need to define 'NO COMPLICATION' in your Complication "

 +7                WRITE "Types file",!,"in order to run this report!"

 +8                QUIT 

               End DoDot:1

               QUIT 

 +9        SET X=$$DIVLOC^RAUTL7()

           IF X

               DO KILL

               QUIT 

 +10       SET A=""

           FOR 

               SET A=$ORDER(RACCESS(DUZ,"DIV-IMG",A))

               IF A']""

                   QUIT 

               Begin DoDot:1

 +11               IF '$DATA(^TMP($JOB,"RA D-TYPE",A))

                       QUIT 

                   SET B=0

 +12               FOR 

                       SET B=+$ORDER(^TMP($JOB,"RA D-TYPE",A,B))

                       IF 'B

                           QUIT 

                       Begin DoDot:2

 +13                       SET ^TMP($JOB,"RACMP",B)=0

 +14                       SET C=""

                           FOR 

                               SET C=$ORDER(RACCESS(DUZ,"DIV-IMG",A,C))

                               IF C']""

                                   QUIT 

                               Begin DoDot:3

 +15                               IF '$DATA(^TMP($JOB,"RA I-TYPE",C))

                                       QUIT 

                                   SET ^TMP($JOB,"RACMP",B,C)=0

 +16                               QUIT 

                               End DoDot:3

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

ASKLOG    ; Ask date range

 +1        KILL A,B,C,^TMP($JOB,"DIV-IMG")

           WRITE !

 +2        DO DATE^RAUTL

           IF RAPOP

               DO KILL

               QUIT 

 +3        SET RADTBEGI=BEGDATE

           SET RADTENDI=ENDDATE

 +4        SET RADTBEG=BEGDATE-.0001

           SET RADTEND=ENDDATE+.9999

 +5        KILL BEGDATE,ENDDATE

 +6        SET Y=RADTBEGI

           XECUTE ^DD("DD")

           SET RADTBEGX=Y

 +7        SET Y=RADTENDI

           XECUTE ^DD("DD")

           SET RADTENDX=Y

 +8        SET ZTDESC="Rad/Nuc Med Complications Report"

 +9        SET ZTRTN="START^RACMP"

           SET ZTSAVE("RACMP")=""

 +10       SET ZTSAVE("RADT*")=""

           SET ZTSAVE("^TMP($J,""RACMP"",")=""

 +11       SET ZTSAVE("^TMP($J,""RA D-TYPE"",")=""

 +12       SET ZTSAVE("^TMP($J,""RA I-TYPE"",")=""

           DO ZIS^RAUTL

 +13       IF RAPOP

               DO KILL

               QUIT 

START     ; Start processing data

 +1        USE IO

           DO NOW^%DTC

           SET (RAPG,RAXIT)=0

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        SET RATDY=$$FMTE^XLFDT(%\1,1)

           SET $PIECE(RALN,"-",(IOM+1))=""

 +4        SET RAERR="No Data Captured For This Time Frame."

 +5        SET RAHDR(1)=">>> Complications Report <<<"

 +6        SET RAHDR(2)="Period: "_RADTBEGX_" to "_RADTENDX_"."

 +7        SET RATAB(1)=$SELECT(IOM=132:15,1:9)

           SET RATAB(2)=$SELECT(IOM=132:24,1:26)

 +8        SET RATAB(3)=$SELECT(IOM=132:40,1:34)

           SET RATAB(4)=$SELECT(IOM=132:52,1:49)

 +9        SET RATAB(5)=$SELECT(IOM=132:90,1:52)

           SET RATAB(6)=$SELECT(IOM=132:102,1:62)

 +10       FOR RADTE=RADTBEG:0

               SET RADTE=$ORDER(^RADPT("AR",RADTE))

               IF 'RADTE!(RADTE>RADTEND)

                   QUIT 

               Begin DoDot:1

 +11               SET RADFN=0

                   FOR 

                       SET RADFN=$ORDER(^RADPT("AR",RADTE,RADFN))

                       IF 'RADFN

                           QUIT 

                       Begin DoDot:2

 +12                       SET RADTI=9999999.9999-RADTE

                           DO SORT^RACMP2

 +13                       QUIT 

                       End DoDot:2

                       IF RAXIT

                           QUIT 

 +14               QUIT 

               End DoDot:1

               IF RAXIT

                   QUIT 

 +15       IF RAXIT

               DO CLOSE^RAUTL

               DO KILL

               QUIT 

 +16       SET X=$ORDER(^TMP($JOB,"RACMP",""))

 +17       IF X=""

               SET Y=X

 +18      IF '$TEST

               SET Y=$ORDER(^TMP($JOB,"RACMP",X,""))

 +19       SET RADIV=X

           SET RAITYPE=Y

           DO HEADER^RACMP2

 +20       IF $DATA(^TMP($JOB,"RACMP"))

               Begin DoDot:1

 +21               DO PRINT^RACMP1

 +22               IF 'RAXIT

                       Begin DoDot:2

 +23                       SET RADIVNM=$$DIVTOT("RACMP")

                           IF 'RADIVNM

                               QUIT 

 +24                       SET (RADIV,RAFLG,RAITYPE)=""

                           SET RAXIT=$$EOS^RAUTL5()

 +25                       IF 'RAXIT

                               DO HEADER^RACMP2

                               DO SYNOP^RACMP2

 +26                       QUIT 

                       End DoDot:2

 +27               QUIT 

               End DoDot:1

 +28       DO CLOSE^RAUTL

           DO KILL

 +29       QUIT 

KILL      ; Kill and quit

 +1        KILL %,%I,RA0,RA1,RA10,RA2,RA3,RA4,RA5,RA7,RACCESS(DUZ,"DIV-IMG"),RACMPTX

 +2        KILL RACNI,RACOMP,RADFN,RADIV,RADIVNM,RADTBEG,RADTBEGI,RADTBEGX,RADTE

 +3        KILL RADTEND,RADTENDI,RADTENDX,RADTI,RAERR,RAEX,RAFLG,RAHDR,RAITYPE,RALN

 +4        KILL RANME,RAPG,RAPHY,RAPOP,RAPRC,RARE,RARES,RASSN,RASTF,RATAB,RATDY,RATME

 +5        KILL RAQUIT,RAXIT,X,Y,ZTDESC,ZTRTN,ZTSAVE

 +6        KILL ^TMP($JOB,"RA D-TYPE"),^TMP($JOB,"RA I-TYPE"),^TMP($JOB,"RACMP")

 +7        KILL ^TMP($JOB,"RACMRE"),^TMP($JOB,"RACNTU"),^TMP($JOB,"RACOMP")

 +8        KILL ^TMP($JOB,"RAEXAM")

 +9        IF $DATA(RAPSTX)

               KILL RACCESS,RAPSTX

 +10       KILL %DT,BEGDATE,I,POP,RAMES

 +11       QUIT 

SET       ; Set data global

 +1        SET X=RADTE

           DO TIME^RAUTL1

           SET RATME=X

 +2        SET RAPRC=+$PIECE(RAEX(0),"^",2)

           SET RAPRC=$GET(^RAMIS(71,RAPRC,0))

 +3        SET RAPRC=$SELECT($PIECE(RAPRC,"^")]"":$EXTRACT($PIECE(RAPRC,"^"),1,20),1:"Unknown")

 +4        SET RARES=+$PIECE(RAEX(0),"^",12)

           SET RARES=$GET(^VA(200,RARES,0))

 +5        SET RARES=$SELECT($PIECE(RARES,"^")]"":$EXTRACT($PIECE(RARES,"^"),1,20),1:"Unknown")

 +6        SET RAPHY=+$PIECE(RAEX(0),"^",14)

           SET RAPHY=$GET(^VA(200,RAPHY,0))

 +7        SET RAPHY=$SELECT($PIECE(RAPHY,"^")]"":$EXTRACT($PIECE(RAPHY,"^"),1,20),1:"Unknown")

 +8        SET RASTF=+$PIECE(RAEX(0),"^",15)

           SET RASTF=$GET(^VA(200,RASTF,0))

 +9        SET RASTF=$SELECT($PIECE(RASTF,"^")]"":$EXTRACT($PIECE(RASTF,"^"),1,20),1:"Unknown")

 +10       SET RACMPTX=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP"))

 +11       SET RACMPTX=$SELECT(RACMPTX]"":RACMPTX,1:"None")

 +12       SET ^TMP($JOB,"RACMP",RADIV,RAITYPE,RANME,RADTE,RACNI)=RAPRC_"^"_RATME_"^"_RAPHY_"^"_RARES_"^"_RASTF_"^"_RACMPTX_"^"_$PIECE(RACOMP,"^")_"^"_RASSN_"^"_RADFN

 +13       QUIT 

DIVTOT(Z) ; Check if more than one division is included in the report.

 +1       ; Pass back '0' if just one division, '1' if more than one division.

 +2        NEW X,Y1,Y2

           SET X=0

 +3        SET Y1=+$ORDER(^TMP($JOB,Z,X))

           IF 'Y1

               QUIT 0

 +4        SET Y2=+$ORDER(^TMP($JOB,Z,Y1))

           IF Y2

               QUIT 1

 +5        QUIT 0