source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACMHIS.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1RACMHIS ;HISC/GJC-Radiology Contrast Media History option (driver)
2 ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
3 ;Note: new routine with the release of RA*5*45
4 ;
5EN ;begin; find all procedures with a CM audit history
6 S RADIC="^RAMIS(71,",RADIC(0)="EMQZ",RADIC("A")="Select Procedure: "
7 S RADIC("S")="I $O(^RAMIS(71,+Y,""AUD"",0))",RAUTIL="RA PROC W/CM"
8 K ^TMP($J,"RA PROC W/CM") D EN1^RASELCT(.RADIC,RAUTIL,"",1)
9 I $O(^TMP($J,"RA PROC W/CM",""))="" D D KILL Q
10 .W !?3,"No procedures have been selected, exiting this option." Q
11 ;
12STRTDT ;Prompt for Starting Date
13 W ! K DIR S DIR(0)="DA^:"_DT_":PEA"
14 S DIR("A")="Enter the start date for the search: "
15 S DIR("?",1)="This is the date from which our search will begin."
16 S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'FROM'."
17 S DIR("?",3)="The starting date must not exceed: "_$$FMTE^XLFDT(DT,"1P")_"."
18 S DIR("?")="Dates associated with a time will not be accepted."
19 D ^DIR K DIR
20 I $D(DIRUT) D KILL Q
21 ;int. date/time ^ ext. date/time ^ int. date/time minus one second
22 S RASTRT=Y_"^"_Y(0)_"^"_$$FMADD^XLFDT(Y,"","","",-1)
23 ;
24ENDDT ;Prompt for Ending Date
25 W ! K DIR S DIR(0)="DA^"_$P(RASTRT,U)_":"_DT_":PEA"
26 S DIR("A")="Enter the ending date for the search: "
27 S DIR("?",1)="This is the date in which our search will end."
28 S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'TO'."
29 S DIR("?",3)="The ending date must not exceed: "_$$FMTE^XLFDT(DT,"1P")_"."
30 S DIR("?",4)="The ending date must not precede: "_$P(RASTRT,U,2)_"."
31 S DIR("?")="Dates associated with a time will not be accepted."
32 D ^DIR K DIR
33 I $D(DIRUT) D KILL Q
34 ;int. date/time ^ ext. date/time ^ int. date/time plus 23hrs, 59 min,
35 ;& 59 seconds
36 S RASTOP=Y_"^"_Y(0)_"^"_(Y+.235959)
37 ;
38 F I="RASTRT","RASTOP","^TMP($J," S ZTSAVE(I)=""
39 K I D EN^XUTMDEVQ("START^RACMHIS","Rad/Nuc Med: Contrast Media History report",.ZTSAVE,,1)
40 I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
41 ;
42KILL ;clean up symbol table
43 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,RADIC,RAQUIT,RASTOP,RASTRT,RAUTIL,X
44 K Y,ZTSAVE,ZTSK,^TMP($J,"RA PROC W/CM")
45 Q
46 ;
47START ;main body
48 S:$D(ZTQUEUED) ZTREQ="@"
49 S RAHD="Contrast Media Edit History By Procedure"
50 S $P(RALINE,"-",(IOM+1))="",RAPG=0,RADT=$$FMTE^XLFDT(DT,"1P")
51 W:$E(IOST,1,2)="C-" @IOF ;clear screen
52 D HDR S RAXIT=0,RAPNME=""
53 F S RAPNME=$O(^TMP($J,"RA PROC W/CM",RAPNME)) Q:RAPNME="" D Q:RAXIT
54 .S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
55 .S RAY=0
56 .F S RAY=$O(^TMP($J,"RA PROC W/CM",RAPNME,RAY)) Q:'RAY D Q:RAXIT
57 ..S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
58 ..S RAS=$P(RASTRT,U,3)
59 ..F S RAS=$O(^RAMIS(71,RAY,"AUD","B",RAS)) Q:'RAS!(RAS>$P(RASTOP,U,3)) D Q:RAXIT
60 ...S RAIEN=0
61 ...F S RAIEN=$O(^RAMIS(71,RAY,"AUD","B",RAS,RAIEN)) Q:'RAIEN D Q:RAXIT
62 ....;get changed date/time, CM value, & user
63 ....S RAY(0)=$G(^RAMIS(71,RAY,"AUD",RAIEN,0))
64 ....S RAADT=$$FMTE^XLFDT($P(RAY(0),U),"1P"),RACMU=$P(RAY(0),U,2)
65 ....S RAX=$S($L(RACMU):$$CONTRAST(RACMU),1:"**User deleted all contrast media data**")
66 ....S:+$P(RAY(0),U,3) RAAU=$$GET1^DIQ(200,$P(RAY(0),U,3)_",",.01)
67 ....I $Y>(IOSL-4) D EOS Q:RAXIT
68 ....W !,$E(RAPNME,1,32),?33,RAADT,?55,$E($G(RAAU),1,24)
69 ....I $Y>(IOSL-4) D EOS Q:RAXIT
70 ....;display the past CM data value or that CM data has been deleted
71 ....S X=RAX,DIWL=3,DIWR=70,DIWF="W" D ^DIWP,^DIWW K ^UTILITY($J,"W")
72 ....Q
73 ...Q
74 ..Q
75 .Q
76EXIT ;clean up symbol table, message to user
77 ;if there are no records to print, alert user
78 W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
79 K DIW,DIWF,DIWL,DIWR,DIWT,DN,I,RAADT,RAAU,RACMU,RADT,RAHD,RAI,RAIEN
80 K RALINE,RAPG,RAPNME,RAS,RAXIT,RAX,RAY,X,Y,Z
81 Q
82 ;
83EOS ; end of screen dialog
84 I $E(IOST,1,2)="C-" D Q:RAXIT
85 .K DIR,DIRUT,DTOUT,DUOUT
86 .S DIR(0)="E" D ^DIR S:$D(DIRUT) RAXIT=1
87 .K DIR,DIRUT,DTOUT,DUOUT
88 .Q
89 ;
90 ;'falls' into HDR...
91 ;
92HDR ; print header
93 W:RAPG @IOF S RAPG=RAPG+1
94 W !,$$CJ^XLFSTR(RAHD,IOM),!,"Run Date: ",RADT,?25,"From: ",$P(RASTRT,U,2),?45,"To: ",$P(RASTOP,U,2),?68,"Page ",RAPG
95 W !,"Procedure",?34,"Date/Time Changed",?55,"User",!?2,"Contrast Media"
96 W !,$$CJ^XLFSTR(RALINE,IOM)
97 Q
98 ;
99CONTRAST(RACMU) ;Return the current CM definition for this procedure delimited
100 ;by commas.
101 ;input: RACMU=internal value of CM; multiple CM references per string
102 ; are possible
103 ;return: the external format of CM delimited by commas
104 N RAI,RAX S RAX=""
105 F RAI=1:1:$L(RACMU) D
106 .S RAX=RAX_$$EXTERNAL^DILFD(71.0125,.01,"",$E(RACMU,RAI))_", "
107 .Q
108 Q $P(RAX,", ",1,($L(RAX,", ")-1)) ;strip off that last ", "
109 ;
Note: See TracBrowser for help on using the repository browser.