source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RALWKL.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RALWKL ;HISC/GJC AISC/MJK,RMO-Workload Reports By Functional Area ;4/12/96 07:54
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4SUM S X=$L(RATITLE)+$L(" Workload Report:")+1
5 S $P(RALN1,"-",X)="" K DIR
6 W @IOF,!?3,RATITLE," Workload Report:",!?3,RALN1,!
7 S DIR(0)="YA",DIR("A")="Do you wish only the summary report? ",DIR("B")="No"
8 S DIR("?")="Enter 'Yes' for a summary report, or 'No' for a detailed report."
9 D ^DIR K DIR I $D(DIRUT) D PURGE^RALWKL2 Q
10 S RASUM=+Y ; if 'RASUM no summary rpt, else summary rpt
11 K DIROUT,DIRUT,DTOUT,DUOUT
12 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
13 K ^TMP($J,"RA"),^TMP($J,"RA1"),^TMP($J,"RAFLD") S RAXIT=0
14 S X=$$DIVLOC^RAUTL7() I X D PURGE^RALWKL2 Q
15 W ! D ONE^RALWKL3(RAFILE)
16 I '$D(^TMP($J,"RAFLD")) W ! D SELECT^RALWKL3
17 I RAXIT D PURGE^RALWKL2 Q
18 D ZEROUT^RALWKL2 ; Zero out totals for division and imaging type
19 D DATE^RAUTL
20 I RAPOP D PURGE^RALWKL2 Q
21 D DISPXAM^RALWKL1(RACRT)
22 I RAXIT D PURGE^RALWKL2 Q
23DEV ; Save off variables, select a device
24 S ZTRTN="START^RALWKL" S:$D(RAFL) ZTSAVE("RAFL*")=""
25 S ZTSAVE("^TMP($J,""RA"",")=""
26 S ZTSAVE("^TMP($J,""RAFLD"",")=""
27 S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
28 S ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
29 F RASV="BEGDATE","ENDDATE","RAFILE","RAPCE","RATITLE","RACRT(","RASUM","RAXIT","RAINPUT","RADIFLG(" S ZTSAVE(RASV)=""
30 W ! D ZIS^RAUTL
31 I RAPOP D PURGE^RALWKL2 Q
32START ; Start the sorting/storing process
33 U IO S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999
34 S:$D(ZTQUEUED) ZTREQ="@"
35 I RAINPUT=0 S RAFLDCNT=0,RALP="" F S RALP=$O(^TMP($J,"RAFLD",RALP)) Q:RALP="" S RAFLDCNT=RAFLDCNT+1
36 K RALP
37 F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND) D Q:RAXIT
38 . F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D RADTI Q:RAXIT
39 . Q
40 D:'RAXIT EN1^RALWKL1
41 D PURGE^RALWKL2
42 Q
43RADTI ; Traverse the Registered Exam multiple
44 S RADTI=0
45 F K RAOR,RABILAT,RAPORT S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0 D Q:RAXIT
46 . I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=$G(^(0)) D RACNI
47 . Q
48 Q
49RACNI ; Traverse the Examinations multiple
50 S RADIV=+$P(RAD0,"^",3),RADIV=+$P($G(^RA(79,RADIV,0)),"^"),RADIV=$S($D(^DIC(4,+RADIV,0)):+RADIV,1:99)
51 S RADIVNME=$S($D(^DIC(4,RADIV,0)):$P(^(0),U,1),1:"Unknown")
52 Q:'$D(^TMP($J,"RA D-TYPE",RADIVNME)) S RACNI=0
53 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D Q:RAXIT
54 . I $D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RAP0=$G(^(0)) D
55 .. I $D(RACRT(+$P(RAP0,"^",3))) D
56 ... S B=$G(RACRT(+$P(RAP0,"^",3))) D IT^RALWKL2 S RAIMG=$S(B1?3AP1"-".N:B1,1:"") D:RAIMG]"" CHK^RALWKL3
57 ... Q
58 .. Q
59 . Q
60 Q
61PRC ; Procedure checks
62 I +RAZ=25 S RAOR="" Q
63 I +RAZ=26 S RAPORT="" Q
64 S:$P(RAZ,"^",3)="Y" RABILAT="" F J=1:1 I '$D(RAMIS(J)) S RAMIS(J)=$S(RAMJ]"":+RAZ,1:99),RAWT(J)=+$P(RAMJ,"^",2),RAMUL(J)=$S(+$P(RAZ,"^",2)>0:+$P(RAZ,U,2),1:1) S:$D(RABILAT)&(RAMUL(J)<2) RAMUL(J)=RAMUL(J)*2 S:J>1 RAMULP="" Q
65 K RABILAT
66 Q
67 ;
68AUX ;
69 I '$D(^TMP($J,"RA",RADIV,RAIMG,RAFLD,A,RAPRC)) D
70 . S ^TMP($J,"RA",RADIV,RAIMG,RAFLD,A,RAPRC)="0^0^0^0^0"
71 S X=$G(^TMP($J,"RA",RADIV,RAIMG,RAFLD,A,RAPRC))
72 S $P(X,"^",C)=$P(X,"^",C)+RANUM,$P(X,"^",5)=$P(X,"^",5)+RAWT
73 S ^TMP($J,"RA",RADIV,RAIMG,RAFLD,A,RAPRC)=X
74 Q
75WARD ; Ward Report Entry Point
76 S ZTDESC="Rad/Nuc Med Functional Area Ward Rpt."
77 S RAFILE="DIC(42,",RACRT=5,RAPCE=6,RATITLE="Ward",RAFL="" G RALWKL
78 ;
79SERV ; Service Report Entry Point
80 S ZTDESC="Rad/Nuc Med Functional Area Service Rpt."
81 S RAFILE="DIC(49,",RACRT=3,RAPCE=7,RATITLE="Service",RAFL="" G RALWKL
82 ;
83BEDSEC ; PTF Bedsection Report Entry Point
84 S ZTDESC="Rad/Nuc Med Functional Area PTF Bedsection Rpt."
85 S RAFILE="DIC(42.4,",RACRT=2,RAPCE=19,RATITLE="PTF Bedsection",RAFL="" G RALWKL
86 ;
87CLINIC ; Clinic Report Entry Point
88 S ZTDESC="Rad/Nuc Med Functional Area Clinic Rpt."
89 S RAFILE="SC(",RACRT=1,RAPCE=8,RATITLE="Clinic",RAFL="" G RALWKL
90 ;
91SHAR ; Sharing Agreement/Contract Report Entry Point
92 S ZTDESC="Rad/Nuc Med Functional Area Sharing Agreement/Contract Rpt."
93 S RAFILE="DIC(34,",RACRT=4,RAPCE=9,RATITLE="Sharing/Contract",RAFL="" G RALWKL
Note: See TracBrowser for help on using the repository browser.