source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1RAWKL ;HISC/FPT AISC/MJK,RMO-Workload Reports ;12/27/00 11:00
2 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
3 ;
4 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
5 ; RAFL flags Tech Rpt and Camera Rpt
6SUM S X="-----------------" W !!,RATITLE," Workload Report:",!,X,$E(X,1,$L(RATITLE)) K RAFL1,^TMP($J)
7ASKSUM ;
8 W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish only the summary report",DIR("B")="NO",DIR("?")="Enter YES for a summary report or NO for a detailed report"
9 D ^DIR K DIR I $D(DIRUT) D Q^RAWKL2 Q
10 I RATITLE["Interpreting" D Q:RAPRIM=-1
11 . S RAPRIM=$$PRI($P(RATITLE," ",2)) D:RAPRIM=-1 Q^RAWKL2
12 . Q
13 S:Y=0 RAFL1=""
14 K DIROUT,DIRUT,DTOUT,DUOUT
15 S X=$$DIVLOC^RAUTL7() I X D Q^RAWKL2 Q
16 S A="" F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
17 . Q:'$D(^TMP($J,"RA D-TYPE",A)) S A1=$O(^TMP($J,"RA D-TYPE",A,0))
18 . Q:A1'>0 S B=""
19 . F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D
20 .. I $D(^TMP($J,"RA I-TYPE",B)) D IT^RALWKL2 I B1?3AP1"-".N S ^TMP($J,"RAWKL",A1,B1)=0
21 .. Q
22 . Q
23 K A,A1,B,B1,RACCESS(DUZ,"DIV-IMG")
24 S RAINPUT=$$ALLNOTH^RALWKL3() I RAINPUT="" D Q^RAWKL2 Q
25 I RAINPUT=0 D RSPTR I RAQUIT=1 D Q^RAWKL2 Q
26 I RAINPUT=0 S RAFLDCNT=0,RALP="" F S RALP=$O(^TMP($J,"RAFLD",RALP)) Q:RALP="" S RAFLDCNT=RAFLDCNT+1
27 K RALP
28 D DATE^RAUTL I RAPOP D Q^RAWKL2 Q
29 S RAXIT=0 D DISPXAM^RALWKL1(RACRT) I RAXIT D Q^RAWKL2 Q
30 S ZTDESC="Rad/Nuc Med "_RATITLE_" Workload Report",ZTRTN="START^RAWKL" S ZTSAVE("RAFL*")="",ZTSAVE("^TMP($J,""RAWKL"",")="",ZTSAVE("^TMP($J,""RAFLD"",")=""
31 F RASV="BEGDATE","ENDDATE","RAFILE","RAFLDCNT","RAPCE","RAPSTX","RATITLE","RACRT","RAINPUT","RAPRIM","RACMLIST" S ZTSAVE(RASV)=""
32 W ! D ZIS^RAUTL I RAPOP D Q^RAWKL2 Q
33START ; start processing
34 U IO K ^TMP($J,"RA") S:$D(ZTQUEUED) ZTREQ="@" K RAEOS
35 S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999,RA80DASH=$$REPEAT^XLFSTR("-",80)
36 S Y=BEGDATE D D^RAUTL S BEGDATE=Y
37 S Y=ENDDATE D D^RAUTL S ENDDATE=Y
38 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDTE=Y
39 D CRIT^RAUTL1 S RACPT=""
40 S RAITCNT=0,RALP=""
41 F S RALP=$O(^TMP($J,"RAWKL",RALP)) Q:RALP="" S RAITCNT(RALP)=0,^TMP($J,"RA",RALP)="0^0^0" S RALP1="" F S RALP1=$O(^TMP($J,"RAWKL",RALP,RALP1)) Q:RALP1="" S RAITCNT(RALP)=RAITCNT(RALP)+1,^TMP($J,"RA",RALP,RALP1)="0^0^0"
42 K RALP,RALP1
43 F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND)!($D(RAEOS)) S RADTI=9999999.9999-RADTE D RADFN^RAWKL1
44 G:'$D(RAEOS) ^RAWKL2
45 Q
46 ;
47TECH S RAFILE="VA(200,",RACRT=7,RAPCE="TC",RATITLE="Technologist",RAFL="" G RAWKL
48 ;
49RES N RAPRIM S RAFILE="VA(200,",RACRT=13,RAPCE=12,RATITLE="Interpreting Resident" G RAWKL
50 ;
51STAFF N RAPRIM S RAFILE="VA(200,",RACRT=14,RAPCE=15,RATITLE="Interpreting Staff" D ASK1 I $D(DIRUT) D Q^RAWKL2 Q
52 G RAWKL
53 ;
54PHY S RAFILE="VA(200,",RACRT=12,RAPCE=14,RATITLE="Requesting M.D." G RAWKL
55 ;
56ROOM S RAFILE="RA(78.6,",RACRT=11,RAPCE=18,RATITLE="Camera/Equip/Room",RAFL="" G RAWKL
57 ;
58RSPTR ; select res/staff/phy/tech/room to include in workload rpts
59 ; Creates ^TMP($J,"RAFLD",File 200 NAME)=""
60 K ^TMP($J,"RAFLD")
61 S RACNT=0
62 ; check for one res/staff/tech only
63 I RACRT=7!(RACRT=13)!(RACRT=14) S RASUBSPT=$S(RACRT=7:"T",RACRT=13:"R",RACRT=14:"S",1:""),RAONECHK=0 F S RAONECHK=$O(^VA(200,"ARC",RASUBSPT,RAONECHK)) Q:RAONECHK=""!(RACNT>1) S RACNT=RACNT+1
64 I RACNT=1 D RST,KILL Q
65 ; check for one physician only
66 I RACRT=12 S RAONECHK=0 F S RAONECHK=$O(^XUSEC("PROVIDER",RAONECHK)) Q:RAONECHK=""!(RACNT>1) S RACNT=RACNT+1
67 I RACNT=1 D P,KILL Q
68 ; check for one camera room only
69 I RACRT=11 S RAONECHK=$P(^RA(78.6,0),U,4) I RAONECHK=1 S RAIEN=$O(^RA(78.6,0)) Q:RAIEN<1 S RAONENME=$P(^RA(78.6,+RAIEN,0),U,1)_$P(^RA(78.6,+RAIEN,0),U,2),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)="" D KILL Q
70 I RACRT=7!(RACRT=13)!(RACRT=14)!(RACRT=12) S RADIC="^VA(200,"
71 I RACRT=11 S RADIC="^RA(78.6,"
72 S RADIC(0)="QEAMZ"
73 S RADIC("A")="Select "_RATITLE_": "
74 I RACRT=7 S RADIC("S")="I $D(^VA(200,""ARC"",""T"",+Y))"
75 I RACRT=13 S RADIC("S")="I $D(^VA(200,""ARC"",""R"",+Y))"
76 I RACRT=14 S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))"
77 I RACRT=12 S RADIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
78 S RAUTIL="RAFLD"
79 D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
80KILL ;
81 K %W,%Y1,DIC,RACNT,RADIC,RAIEN,RAONECHK,RAONENME,RASUBSPT,RAUTIL,X,Y
82 Q
83RST ; resident/staff/tech
84 S RAIEN=$O(^VA(200,"ARC",RASUBSPT,0)),RAONENME=$P(^VA(200,+RAIEN,0),U,1),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)=""
85 Q
86P ; physicians
87 S RAIEN=$O(^XUSEC("PROVIDER",0)),RAONENME=$P(^VA(200,+RAIEN,0),U,1),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)=""
88 Q
89PRI(RACLS) ; Ask user to include Pri. Res/Staff only in the
90 ; 'Interpreting Res/Staff' report
91 ; Input: RACLS-> 'Resident' or 'Staff'
92 ; Returns: 1 if Pri. Staff only, 0 if Pri. & Sec. Staff included, and
93 ; -1 if exiting without a report
94 W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT N X,Y
95 S DIR(0)="Y",DIR("A")="Count "_RACLS_" when entered as 'secondary'"_$S(RACLS?1"S".E:" staff",1:" resident")_" interpreter",DIR("B")="Yes"
96 S DIR("?",1)="Answer 'Yes' if both Primary and Secondary "_RACLS_" personnel will be included"
97 S DIR("?",2)="in this report. Answer 'No' if only Primary "_RACLS_" personnel will be"
98 S DIR("?")="included in this report. Input a '^' to exit without a report."
99 D ^DIR S:$D(DIRUT) Y=-1 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
100 Q $S(+Y=-1:-1,+Y:0,1:1)
101ASK1 ; ask user if want to put CPT modifiers as separate line items
102 K DIR S DIR(0)="Y",DIR("B")="NO"
103 S DIR("A")="Do you want to count CPT Modifiers separately"
104 S DIR("?")="Enter YES to put different combinations of CPT modifiers onto separate lines"
105 W ! D ^DIR K DIR
106 S:Y RACMLIST=1 ;=1 means to list CPT mods as separate line items
107 Q
Note: See TracBrowser for help on using the repository browser.