- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADLQ3.m
r613 r623 1 RADLQ3 ;HISC/GJC-Delq Status/Incomplete Rpt's ;5/7/97 15:58 2 ;;5.0;Radiology/Nuclear Medicine;**87**;Mar 16, 1998;Build 2 3 ; 11/15/07 BAY/KAM RA*5*87 Rem Call 217642 change pat ssn to display last four 4 DISPXAM ; Display exam statuses for selected Imaging Types. These exam 5 ; statuses need the 'DELINQUENT STATUS REPORT?' field tripped to 6 ; 'yes' in file 72. 7 N RA,RAHD,UNDRLN,X,Y,Z 8 S RAHD(0)="The entries printed for this report will be based only" 9 S RAHD(1)="on exams that are in one of the following statuses:" 10 I '$D(RALL) D 11 . W !!?(IOM-$L(RAHD(0))\2),RAHD(0) 12 . W !?(IOM-$L(RAHD(1))\2),RAHD(1) 13 . Q 14 S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT 15 . I $D(^RA(72,"AA",X)) S Y="" K UNDRLN D 16 .. I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF 17 .. I '$D(RALL) S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN 18 .. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT 19 ... S Z=0 F S Z=+$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT 20 .... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3)) 21 .... S RA(.3,15)=$P(RA(.3),"^",15) 22 .... I RA(0)]"",(RA(.3)]""),(RA(.3,15)]""),("Yy"[RA(.3,15)) D 23 ..... S RACRT(Z)="" 24 ..... I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D 25 ...... W @IOF,!?10,X,!?10,UNDRLN 26 ...... Q 27 ..... W:'$D(RALL) !?15,$P(RA(0),"^") 28 ..... Q 29 .... Q 30 ... Q 31 .. Q 32 . Q 33 Q 34 OUTPUT ; Print out the results 35 N RAEOS I $D(RAVAR(0)),(RAVAR(0)'=RAVAR) S RAEOS=6 36 E S RAEOS=4 37 F I=1:1:$L(RANODE,"^") D 38 . S @$P("RACN^RAPRC^RAST^RADT^RAWHE^RARP^RASSN^RAVRFIED^RAIPHY^RATECH","^",I)=$P(RANODE,"^",I) 39 . Q 40 I $Y>(IOSL-RAEOS) D Q:RAXIT 41 . S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 42 . Q 43 I RAEOS=6 D 44 . N RASTR S RASTR="*** OUTPATIENT ***" 45 . S RASTR(0)=$$REPEAT^XLFSTR(" ",((IOM-($L(RASTR)*3))\2)) 46 . S RASTR(1)=RASTR_RASTR(0)_RASTR_RASTR(0)_RASTR 47 . W !!,RASTR(1) 48 . Q 49 ; Note: Inform the user that the following data will be for outpatients. 50 ; Since only inpatient and outpatient is possibly stored, any 51 ; change in the variable RAVAR will be a change to 'outpatient'. 52 ; 11/15/07 BAY/KAM RA*5*87 Rem Call 217642 Added next line 53 S RASSN=$E(RASSN,8,11) 54 I IOM=132 D ;132 column format 55 . W !,RANME,?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT,?RATAB(4) 56 . W $E(RAWHE,1,25),?RATAB(5),RAVRFIED 57 . W !?RATAB(6),$E(RAPRC,1,30),?RATAB(7),$E(RAST,1,30) 58 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,20),?RATAB(10),RATECH 59 . Q 60 E D ;default to 80 column 61 . W !,$E(RANME,1,20),?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT 62 . W ?RATAB(4),$E(RAWHE,1,15),?RATAB(5),RAVRFIED 63 . W !?RATAB(6),$E(RAPRC,1,20),?RATAB(7),$E(RAST,1,11) 64 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,15),?RATAB(10),RATECH 65 . Q 66 W !,RALN1 67 S RAVAR(0)=RAVAR ; track the patient status: inpatient -or- outpatient 68 Q 69 CHECK(DUZ) ; Check for the existence of RACCESS. Pass in user's DUZ! 70 S RAPSTX="" D SETVARS^RAPSET1(0) 71 Q 72 LIST ; List divisions and I-Types 73 N A,B S A="" 74 F S A=$O(^TMP($J,"RADLQ",A)) Q:A']"" D 75 . W !!,"Division: ",$P($G(^DIC(4,A,0)),"^"),!?3,"Imaging Type(s): " 76 . S B="" F S B=$O(^TMP($J,"RADLQ",A,B)) Q:B']"" D Q:RAXIT 77 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT 78 .. W:$X>(IOM-30) !?($X+$L("Imaging Type(s): ")+3) W B,?($X+3) 79 .. Q 80 . Q 81 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT 82 W !!?RATAB(6),"Total Over All Divisions: ",+$G(^TMP($J,"RADLQ")) 83 Q 84 EXIT ; Kill and quit 85 K %DT,BEGDATE,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,I,INVMAXDT,RA,RA1,RA2 86 K RABEG,RACN,RACNI,RACRT,RADFN,RADIV,RADIVNM,RADT,RADTE,RADTI,RAEND 87 K RAEXAM,RAFLAG,RAHD,RAHEAD,RAIPHY,RAITYPE,RALN1,RALN2,RAMES,RANME 88 K RANODE,RAPAT,RAPG,RAPOP,RAPRC,RAQUIT,RAREGEX,RARP,RASORT1,RASORT2 89 K RASSN,RAST,RASTI,RASV,RATAB,RATECH,RAVAR,RAVRFIED,RAWHE,RAXIT 90 K X,Y,ZTDESC,ZTRTN,ZTSAVE 91 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RADLQ") 92 K:$D(RAPSTX) RACCESS,RAPSTX D CLOSE^RAUTL 93 K DISYS,I,POP 94 Q 95 ZEROUT(SUB) ; Zero out the ^TMP($J global. 96 N X,Y,Z 97 S X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D 98 . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=0 99 . F S Y=+$O(^TMP($J,"RA D-TYPE",X,Y)) Q:'Y D 100 .. S ^TMP($J,SUB,Y)=0,Z="" 101 .. F S Z=$O(RACCESS(DUZ,"DIV-IMG",X,Z)) Q:Z']"" D 102 ... Q:'$D(^TMP($J,"RA I-TYPE",Z)) S ^TMP($J,SUB,Y,Z)=0 103 ... I SUB="RADLQ" D 104 .... S:RASORT1'="B" ^TMP($J,SUB,Y,Z,RASORT1)=0 105 .... S:RASORT1="B" ^TMP($J,SUB,Y,Z,"I")=0,^TMP($J,SUB,Y,Z,"O")=0 106 .... Q 107 ... Q 108 .. Q 109 . Q 110 Q 1 RADLQ3 ;HISC/GJC-Delq Status/Incomplete Rpt's ;5/7/97 15:58 2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998 3 DISPXAM ; Display exam statuses for selected Imaging Types. These exam 4 ; statuses need the 'DELINQUENT STATUS REPORT?' field tripped to 5 ; 'yes' in file 72. 6 N RA,RAHD,UNDRLN,X,Y,Z 7 S RAHD(0)="The entries printed for this report will be based only" 8 S RAHD(1)="on exams that are in one of the following statuses:" 9 I '$D(RALL) D 10 . W !!?(IOM-$L(RAHD(0))\2),RAHD(0) 11 . W !?(IOM-$L(RAHD(1))\2),RAHD(1) 12 . Q 13 S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT 14 . I $D(^RA(72,"AA",X)) S Y="" K UNDRLN D 15 .. I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF 16 .. I '$D(RALL) S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN 17 .. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT 18 ... S Z=0 F S Z=+$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT 19 .... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3)) 20 .... S RA(.3,15)=$P(RA(.3),"^",15) 21 .... I RA(0)]"",(RA(.3)]""),(RA(.3,15)]""),("Yy"[RA(.3,15)) D 22 ..... S RACRT(Z)="" 23 ..... I '$D(RALL),($Y>(IOSL-4)) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D 24 ...... W @IOF,!?10,X,!?10,UNDRLN 25 ...... Q 26 ..... W:'$D(RALL) !?15,$P(RA(0),"^") 27 ..... Q 28 .... Q 29 ... Q 30 .. Q 31 . Q 32 Q 33 OUTPUT ; Print out the results 34 N RAEOS I $D(RAVAR(0)),(RAVAR(0)'=RAVAR) S RAEOS=6 35 E S RAEOS=4 36 F I=1:1:$L(RANODE,"^") D 37 . S @$P("RACN^RAPRC^RAST^RADT^RAWHE^RARP^RASSN^RAVRFIED^RAIPHY^RATECH","^",I)=$P(RANODE,"^",I) 38 . Q 39 I $Y>(IOSL-RAEOS) D Q:RAXIT 40 . S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 41 . Q 42 I RAEOS=6 D 43 . N RASTR S RASTR="*** OUTPATIENT ***" 44 . S RASTR(0)=$$REPEAT^XLFSTR(" ",((IOM-($L(RASTR)*3))\2)) 45 . S RASTR(1)=RASTR_RASTR(0)_RASTR_RASTR(0)_RASTR 46 . W !!,RASTR(1) 47 . Q 48 ; Note: Inform the user that the following data will be for outpatients. 49 ; Since only inpatient and outpatient is possibly stored, any 50 ; change in the variable RAVAR will be a change to 'outpatient'. 51 I IOM=132 D ;132 column format 52 . W !,RANME,?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT,?RATAB(4) 53 . W $E(RAWHE,1,25),?RATAB(5),RAVRFIED 54 . W !?RATAB(6),$E(RAPRC,1,30),?RATAB(7),$E(RAST,1,30) 55 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,20),?RATAB(10),RATECH 56 . Q 57 E D ;default to 80 column 58 . W !,$E(RANME,1,20),?RATAB(1),RACN,?RATAB(2),RASSN,?RATAB(3),RADT 59 . W ?RATAB(4),$E(RAWHE,1,15),?RATAB(5),RAVRFIED 60 . W !?RATAB(6),$E(RAPRC,1,20),?RATAB(7),$E(RAST,1,11) 61 . W ?RATAB(8),RARP,?RATAB(9),$E(RAIPHY,1,15),?RATAB(10),RATECH 62 . Q 63 W !,RALN1 64 S RAVAR(0)=RAVAR ; track the patient status: inpatient -or- outpatient 65 Q 66 CHECK(DUZ) ; Check for the existence of RACCESS. Pass in user's DUZ! 67 S RAPSTX="" D SETVARS^RAPSET1(0) 68 Q 69 LIST ; List divisions and I-Types 70 N A,B S A="" 71 F S A=$O(^TMP($J,"RADLQ",A)) Q:A']"" D 72 . W !!,"Division: ",$P($G(^DIC(4,A,0)),"^"),!?3,"Imaging Type(s): " 73 . S B="" F S B=$O(^TMP($J,"RADLQ",A,B)) Q:B']"" D Q:RAXIT 74 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT 75 .. W:$X>(IOM-30) !?($X+$L("Imaging Type(s): ")+3) W B,?($X+3) 76 .. Q 77 . Q 78 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HDR^RADLQ2 Q:RAXIT 79 W !!?RATAB(6),"Total Over All Divisions: ",+$G(^TMP($J,"RADLQ")) 80 Q 81 EXIT ; Kill and quit 82 K %DT,BEGDATE,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,I,INVMAXDT,RA,RA1,RA2 83 K RABEG,RACN,RACNI,RACRT,RADFN,RADIV,RADIVNM,RADT,RADTE,RADTI,RAEND 84 K RAEXAM,RAFLAG,RAHD,RAHEAD,RAIPHY,RAITYPE,RALN1,RALN2,RAMES,RANME 85 K RANODE,RAPAT,RAPG,RAPOP,RAPRC,RAQUIT,RAREGEX,RARP,RASORT1,RASORT2 86 K RASSN,RAST,RASTI,RASV,RATAB,RATECH,RAVAR,RAVRFIED,RAWHE,RAXIT 87 K X,Y,ZTDESC,ZTRTN,ZTSAVE 88 K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RADLQ") 89 K:$D(RAPSTX) RACCESS,RAPSTX D CLOSE^RAUTL 90 K DISYS,I,POP 91 Q 92 ZEROUT(SUB) ; Zero out the ^TMP($J global. 93 N X,Y,Z 94 S X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D 95 . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=0 96 . F S Y=+$O(^TMP($J,"RA D-TYPE",X,Y)) Q:'Y D 97 .. S ^TMP($J,SUB,Y)=0,Z="" 98 .. F S Z=$O(RACCESS(DUZ,"DIV-IMG",X,Z)) Q:Z']"" D 99 ... Q:'$D(^TMP($J,"RA I-TYPE",Z)) S ^TMP($J,SUB,Y,Z)=0 100 ... I SUB="RADLQ" D 101 .... S:RASORT1'="B" ^TMP($J,SUB,Y,Z,RASORT1)=0 102 .... S:RASORT1="B" ^TMP($J,SUB,Y,Z,"I")=0,^TMP($J,SUB,Y,Z,"O")=0 103 .... Q 104 ... Q 105 .. Q 106 . Q 107 Q
Note:
See TracChangeset
for help on using the changeset viewer.
