source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTST2A.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1RARTST2A ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Reports Distribution ;11/24/97 12:12
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4DIV ; Division selection
5 ; save all Med Center Divisions (40.8) by pntr to file 4
6 D LIST^DIC(40.8,"",.07,"I","*","","","","","","RA408")
7 Q:'$D(RA408("DILIST","ID")) ; quit if no data
8 S RAI=0 F S RAI=$O(RA408("DILIST","ID",RAI)) Q:RAI'>0 D
9 . ; for all entries in 40.8, save off the Institution File Pointer data
10 . ; (Inst. File Pntr data is subscript) set the local array equal to the
11 . ; appropriate ien in 40.8 - Example: RA4('ien file 4')='ien file 40.8'
12 . S:$G(RA408("DILIST","ID",RAI,.07))]"" RA4($G(RA408("DILIST","ID",RAI,.07)))=$G(RA408("DILIST",2,RAI))
13 . S:$G(RA408("DILIST",2,RAI))]"" RAF408(RA408("DILIST",2,RAI))=""
14 . Q
15 K RAPRMPT S I1=$P($G(^RABTCH(74.3,RAB,0)),"^")
16 I I1="CLINIC REPORTS"!(I1="WARD REPORTS")!(I1="REQUESTING PHYSICIAN") S RAPRMPT=" Requesting Division: "
17 E S RAPRMPT=" Exam Division: "
18 K RADIV S (C,I1)=0 F I=0:0 S I=$O(^RA(79,I)) Q:'I S C=C+1,I1=I Q:C>1
19 I C=1,$D(RA4(I1)) S RADIV=I1 K C,I,I1 G IMAG
20 I $D(RAMDIV),$D(RA4(+RAMDIV)) S DIC("B")=+RAMDIV
21 W !!,"Division Selection:",!,"-------------------"
22 S DIC(0)="AEMQZ",DIC="^DIC(4,",DIC("A")=RAPRMPT
23 S DIC("S")="I $D(RA4(+Y))" ; only institutions linked to Med Center Divs
24 D ^DIC K DIC("A"),DIC("B"),DIC("S"),RAPRMPT S RADIV=+Y
25 K C,I,I1,RA408,RAI Q:RADIV'>0
26 S I=0 F S I=$O(RA4(I)) Q:I'>0 D
27 . S I(0)=$G(RA4(I))
28 . I I'=RADIV K RA4(I),RAF408(I(0))
29 . Q
30 K I
31 ;
32IMAG ;imaging type selection
33 K RAIMAG I $D(RAOMA) D Q:'$D(RAIMAG)
34 . S RAIMAG=$$IMG^RARTST3()
35 . ; allow the users to select all i-types regardless of division
36 . ; if i-types have been selected, RAIMAG is set to one, else 0
37 . K:'RAIMAG RAIMAG
38 . Q
39 E D Q:'$D(RAIMAG)
40 . W !!,"Imaging Type Selection:",!,"-----------------------"
41 . S DIR(0)="PA^79.2:AEMQ",DIR("A")="Select Imaging Type: "
42 . S:$D(RAMLC) DIR("B")=$P($$IMAG^RASITE(+$P(RAMLC,U,6)),U,2)
43 . D ^DIR K DIR Q:Y'>0!$D(DIRUT) S RAIMAG(+Y)=""
44 . Q
45 I $D(^RABTCH(74.3,"B","REQUESTING PHYSICIAN",RAB))#2 D G LOC
46 . S RASRT(0)="Patient",RASRT="P"
47 . Q
48 ;
49SORT W !!,"Sort Sequence Selection:",!,"------------------------"
50 K RASRT S RARD(1)="Terminal Digits^sort reports by terminal digit of SSN",RARD(2)="SSN^sort reports by SSN",RARD(3)="Patient^sort reports by patient's name",RARD("A")="Select Sequence: ",RARD("B")=3
51 D SET^RARD K RARD Q:"^"[X S RASRT=$E(X),RASRT(0)=X
52 ;
53LOC I $G(RARTST1)=1 D Q:"^"[RALOCSRT ; *** [RA RPTDISTQUE] option only ***
54 . W !!,"First Sort Selection:",!,"---------------------"
55 . K DIR S DIR(0)="YO",DIR("B")="Yes"
56 . S DIR("A")=" Sort by patient location before "_RASRT(0)
57 . S DIR("?",1)="Enter YES to sort the report by patient location, then by "_RASRT(0)_"."
58 . S DIR("?",2)="Enter NO to sort the report by "_RASRT(0)_", with no sort by location."
59 . S DIR("?")="Choose either YES or NO."
60 . D ^DIR K DIR S RALOCSRT=$S($D(DIRUT):U,1:Y)
61 . Q
62 E S RALOCSRT=1
63 ;
64PRINT K RAPRT W !!,"Print/Reprint Reports Selection:",!,"--------------------------------"
65 S RARD(1)="UNPRINTED^print verified reports that have not been printed",RARD(2)="REPRINT^reprint previously printed reports",RARD("B")=1 D SET^RARD K RARD Q:"^"[X
66 S RAPRT=X Q:$E(RAPRT)="U"
67 ;
68DATE K RABEG,RAEND W !!,"Date Range Selection:",!,"---------------------"
69 S %DT("B")="T@1201AM",%DT="APRETX",%DT("A")=" Beginning DATE/TIME of Initial Print : " D ^%DT I Y<0 K RAPRT Q
70 S (%DT(0),RABEG)=Y
71 W ! S %DT("B")="NOW",%DT="APRETX",%DT("A")=" Ending DATE/TIME of Initial Print : " D ^%DT K %DT I Y<0 K RAPRT Q
72 W ! S RAEND=Y Q
73RPTST(RARPT) ; Report's Print Status, called from 8^RARTST1.
74 ; This code replaces the call to the compiled template routine.
75 ; Input: RARPT -> ien of the Report in file 74
76 N I,RA74,RAEXFLD,RAY3,X,Y W !,$$REPEAT^XLFSTR("-",IOM),!!
77 S RA74(0)=$G(^RARPT(RARPT,0)) W "Report : ",$P(RA74(0),"^")
78 S (X,Y)=+$P(RA74(0),"^",2),Y=$S($D(^DPT(Y,0))#2:$P(^(0),"^"),1:"")
79 W ?25,"Patient: ",$E(Y,1,30) W:X ?65,$$SSN^RAUTL(X)
80 S Y=+$O(^RADPT(X,"DT",(9999999.9999-$P(RA74(0),"^",3)),"P","B",$P(RA74(0),"^",4),0))
81 S RAY3=$G(^RADPT(X,"DT",(9999999.9999-$P(RA74(0),"^",3)),"P",Y,0))
82 S RAEXFLD="PROC" D ^RARTFLDS W !,"Procedure: ",$E(X,1,30)
83 W ?45,"Verified: ",$$FMTE^XLFDT($P(RA74(0),"^",7),"1P")
84 W !!?4,"Routing Queue",?24,"Date Printed",?44,"Printed By",?62,"Ward/Clinic"
85 W !?4,"-------------",?24,"------------",?44,"----------",?62,"-----------"
86 S I=0 F S I=$O(^RABTCH(74.4,"B",RARPT,I)) Q:I'>0 D
87 . S X=$G(^RABTCH(74.4,I,0)),Y=+$P(X,"^",11)
88 . S Y=$S($D(^RABTCH(74.3,Y,0))#2:$P(^(0),"^"),1:"")
89 . W !,$E(Y,1,20),?24,$E($$FMTE^XLFDT($P(X,"^",4),1),1,18)
90 . S Y=+$P(X,"^",3),Y=$S($D(^VA(200,Y,0))#2:$P(^(0),"^"),1:"")
91 . W ?44,$E(Y,1,17),?62
92 . W:+$P(X,"^",6) $E($$GET1^DIQ(42,+$P(X,"^",6),.01),1,18)
93 . W:+$P(X,"^",8) $E($$GET1^DIQ(44,+$P(X,"^",6),.01),1,18)
94 . Q
95 W !!,$$REPEAT^XLFSTR("=",IOM),!
96 Q
Note: See TracBrowser for help on using the repository browser.