source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAKRDIT.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: 6.3 KB
Line 
1RAKRDIT ;Hines OI/GJC-pass exam info within a date range, to PCE
2 ;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998
3 Q
4EN1 ;DBIA 3445 read from file 42
5 ;Supported entry point used to credit examinations that have failed
6 ;to be credited in the past. The user will be asked to supply the
7 ;following required information:
8 ;* Imaging Location (active, receives regular credit, & has a DSS ID)
9 ;* Date Range
10 ;
11 ;From this, we look at the exam records and determine if the exam
12 ;has been credited and whether or not the patients are outpatients.
13 ;
14 ;The software needs to check if these exams are single exams or
15 ;exam-sets (linked to a single report, known as a print-set, or
16 ;linked to unique reports) and send to PCE only those exams that
17 ;have an Exam Status of 'Complete'.
18 ;
19 ;Intergration Agreements (IAs) used within this software
20 ;#3445-$$GET1^DIQ(42,ien_file_42,.03,"I") ;the SERVICE of the ward
21 ;
22IMGLOC W !!,?2,"Select an Imaging Location from the IMAGING LOCATIONS (#79.1)"
23 W !?2,"file that is active, receives regular credit, and has a valid"
24 W !?2,"DSS ID.",!
25 K DIC S RATDY=$$DT^XLFDT(),DIC="^RA(79.1,"
26 S DIC("S")="N RAI S RAI=$G(^(0)) I '$P(RAI,""^"",19),($P(RAI,""^"",21)=0),($P(RAI,""^"",22)]"""")"
27 S DIC("A")="Enter the Imaging Location that you wish to credit: "
28 S DIC(0)="QEANZ" D ^DIC K DIC
29 I Y=-1 D D KILL Q
30 .W !!?2,$C(7),"Imaging Location selection invalid, exiting."
31 .Q
32 S RAILOC=Y_"^"_Y(0,0) ;ien file 79.1^ien file 44^.01 value file 44
33 ;
34DATE1 K DIR S DIR(0)="D^2110101:"_RATDY_":EA"
35 S DIR("?",1)="Enter the date to begin searching for exams that have not been credited."
36 S DIR("A")="Enter the starting date: ",DIR("?")="Time is not allowed."
37 D ^DIR K DIR
38 I $D(DIRUT) D D KILL Q
39 .W !!?2,$C(7),"Starting date not selected, exiting."
40 .Q
41 S (RASTRT,RADTE)=Y
42 ;
43DATE2 K DIR S DIR(0)="D^"_RASTRT_":"_RATDY_":EA"
44 S DIR("A")="Enter the ending date: "
45 S DIR("?",1)="Enter the date to end the search for exams that have not been credited."
46 S DIR("?")="Dates cannot preceed: "_$$FMTE^XLFDT(RASTRT,"1P")_"; time is not allowed."
47 D ^DIR K DIR
48 I $D(DIRUT) D D KILL Q
49 .W !!?2,$C(7),"Ending date not selected, exiting."
50 .Q
51 S RAEND=$$FMADD^XLFDT(Y,0,24,0,0) ;to include all data, set to midnight
52 ;
53 S ZTIO="",ZTRTN="QUEUED^RAKRDIT",ZTDESC="Rad/Nuc Med attempt to credit exams for a specific imaging location and date range"
54 F I="RAEND","RADTE","RASTRT","RAILOC" S ZTSAVE(I)=""
55 W ! D ^%ZTLOAD
56 I $D(ZTSK) D
57 .W !!?2,"Request queued: "_ZTSK_" @ "_$$HTE^XLFDT($G(ZTSK("D"),"error"))
58 .Q
59 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK D KILL
60 Q
61 ;
62QUEUED ;begin checking for uncredited exams...
63 S:$G(U)'="^" U="^" S:$D(ZTQUEUED) ZTREQ="@" S RAXIT=0
64EXAMS F S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND) D
65 .;^RADPT("AR",date/time of exam,patient dfn,inverse exam date/time)=""
66 .S RADFN=0
67 .F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D Q:RAXIT
68 ..S RADTI=0
69 ..F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0 D Q:RAXIT
70 ...S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RAXSET=0
71 ...Q:$P(RAY2,"^",4)'=+RAILOC ;not the specified I-Loc
72 ...S RACNI=0
73 ...;check the exam to see if it is part of an exam set. If it is,
74 ...;the call to RAPCE performs checking logic on all the descendents.
75 ...I $P(RAY2,"^",5) S RAXSET=1 D Q ;we have an exam set...
76 ....S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0
77 ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
78 ....Q:+$$EN1^RASETU($P(RAY3,U,11),RADFN)'=9 ; check all descendents
79 ....;for a minimum order number of nine (9). This indicates that all
80 ....;descendents are in the COMPLETE examination status. Status info
81 ....;about exam set passed back from EN1^RASETU in the following
82 ....;format: min status_"^"_max status_"^"_$S(All_Statuses=0:1,1:0)
83 ....Q:$$ELIG(RAY3) ;must be an outpatient
84 ....D COMPLETE^RAPCE(RADFN,RADTI,RACNI)
85 ....D XAMSET(RADFN,RADTI) ;CREDIT METHOD of Reg. Credit on descendents
86 ....I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
87 ....Q
88 ...;we do not have an exam set, proceed as usual...
89 ...F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D Q:RAXIT
90 ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
91 ....Q:$$ELIG(RAY3) ;must be an outpatient
92 ....D COMPLETE^RAPCE(RADFN,RADTI,RACNI)
93 ....D:$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,24)="Y" CREDITM(RADFN,RADTI,RACNI) ;update CREDIT METHOD fld from No Credit to Regular Credit
94 ....I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
95 ....Q
96 ...I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
97 ...Q
98 ..I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
99 ..Q
100 .I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
101 .Q
102 Q
103KILL ; kill local variables, clean up partition
104 K DIC,DIRUT,DTOUT,DUOUT,I,RADFN,RADTE,RADTI,RAEND,RAILOC,RASTRT,RATDY
105 K RAXIT,RAXSET,RAY2,RAY3,X,Y
106 Q
107ELIG(RAY3) ;Is this record eligible to be credited? If so, the CLINIC
108 ;STOP RECORDED? (#23) cannot be set to yes, the patient must not be
109 ;located on a ward (outpatient), & the exam must be in a complete
110 ;status (order_number = 9)
111 ;Input: RAY3 set to - ^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
112 I 'RAXSET,($P($G(^RA(72,+$P(RAY3,"^",3),0)),U,3)='9) Q 1 ;check single
113 ;exam records for an order number of nine (9). This means the exam is
114 ;in a status of COMPLETE. Note: the order numbers of the descendent
115 ;exams within an exam-set is checked with $$EN1^RASETU...
116 Q:$P(RAY3,"^",24)="Y" 1 ;clinic stop credited, skip this exam
117 I $P(RAY3,"^",6)]"",($$GET1^DIQ(42,$P(RAY3,"^",6),.03,"I")'="D") Q 1
118 ;Note: if a ward, then it must have a SERVICE of DOMICILIARY to be
119 ;consider an outpatient
120 Q 0
121 ;
122CREDITM(RADFN,RADTI,RACNI) ;Change the CREDIT METHOD (DD: 70.03, fld: 26)
123 ;from "No Credit" (2) to "Regular Credit" (0)
124 ;Note: Crediting was skipped because the Imaging Location (I-Loc) was
125 ;marked as 'NO CREDIT'. To credit at this time, the I-Loc must have
126 ;CREDIT METHOD set to 'REGULAR CREDIT'. All exam records must be
127 ;updated accordingly.
128 ;Input=RADFN: patient dfn, RADTI: inv. exam date/time, RACNI: case ien
129 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",26)=0 ; zero
130 D FILE^DIE("K","RAFDA")
131 Q
132 ;
133XAMSET(RADFN,RADTI) ; change CREDIT METHOD from No Credit to Regular Credit
134 ;Input=RADFN: patient dfn, RADTI: inv. exam date/time
135 N RACNI S RACNI=0
136 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
137 .D:$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,24)="Y" CREDITM(RADFN,RADTI,RACNI) ;update CREDIT METHOD fld from No Credit to Regular Credit
138 Q
Note: See TracBrowser for help on using the repository browser.