source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL3.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: 3.0 KB
Line 
1RAUTL3 ;HISC/CAH,FPT,GJC AISC/SAW-Utility for Callable Entry Points ;4/1/97 10:04
2 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
3EN1 ;ENTRY POINT FOR AMIE CALL
4 ;Requires four input variables
5 ; DFN = Patient internal entry number
6 ; Date range for report in Fileman internal format
7 ; RABDT = Beginning Date (time optional)
8 ; RAEDT = Ending Date (time optional)
9 ; Exam locations (from file 44, Hospital Location) that are to be
10 ; included in the report
11 ; RAHLOC = A string of internal entry numbers for locations
12 ; Each location separated by ^ and RAHLOC must begin
13 ; and end with an ^ (e.g., RAHLOC=^3^ or RAHLOC=^56^75^)
14 ; These are REQUESTING locations, not imaging locations
15 ;
16 I '$D(DFN)!('$D(RAHLOC))!('$D(RABDT))!('$D(RAEDT)) W !!,"Required variables are not defined. Unable to continue.",*7 Q
17 S RAMIE=1 F RAPTR=RABDT-.0000001:0 S RAPTR=$O(^RADPT(DFN,"DT","B",RAPTR)) Q:RAPTR'>0!(RAPTR>RAEDT) S RAPTR1=$O(^(RAPTR,0)) I RAPTR1 F RAPTR2=0:0 S RAPTR2=$O(^RADPT(DFN,"DT",RAPTR1,"P",RAPTR2)) Q:RAPTR2'>0 I $D(^(RAPTR2,0)) S RAEX=^(0) D CHK
18 K RACNI,RAEX,RAII,RAK,RAMDIV,RAMDV,RAMLC,RAMIE,RANUM,RAPT1,RAPTR,RAPTR1,RAPTR2,RASSN,RAST Q
19CHK I $P(RAEX,U,17),RAHLOC[(U_$P(RAEX,U,22)_U) S RAST=$S($D(^RARPT($P(RAEX,"^",17),0)):^(0),1:"") I "VR"[$P(RAST,"^",5) S RARPT=$P(RAEX,"^",17),RAPT1=1 D ^RARTR F RAK=0:0 S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 I $D(^(RAK,0)) K @$P(^(0),"^",5)
20 Q
21SIGNON ;Check the # of reports to either pre-verify of verify.
22 Q:'$D(DUZ)#2 N RA74,X0,X1,Y1 S (X0,X1,Y1)=0
23 ; first, tabulate # (Y1) of reports to pre-verify (if any)
24 F S X0=$O(^RARPT("ARES",DUZ,X0)) Q:X0'>0 D
25 . S RA74=$G(^RARPT(X0,0))
26 . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501
27 . Q:$P(RA74,"^",5)="V" ; skip if already verified
28 . S:$P(RA74,"^",12)']"" Y1=Y1+1
29 . Q
30 S:Y1 X0="!*** You have "_Y1_" imaging report"_$S(Y1>1:"s",1:"")_" to pre-verify. ***"
31 D:Y1 SET^XUS1A(X0)
32 ; next tabulate # (X1) of reports to verify (if any)
33 S X0=0 F S X0=$O(^RARPT("ASTF",DUZ,X0)) Q:X0'>0 D
34 . S RA74=$G(^RARPT(X0,0))
35 . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501
36 . Q:$P(RA74,"^",5)="V" ; skip if already verified
37 . S X1=X1+1
38 Q:X1'>0
39 S X0="!*** You have "_X1_" imaging report"_$S(X1>1:"s",1:"")_" to verify. ***"
40 D SET^XUS1A(X0)
41 Q
42UPDT(RANODE) ; Delete blank lines for Rad/Nuc Med Word Processing fields.
43 ; These 'blank' consist of nothing more than spaces.
44 ; 'RANODE' is the data node to be examined: i.e, for Clinical History
45 ; in Rad/Nuc Med Orders (75.1) RANODE="^RAO(75.1,"_DA_",H,"
46 ; -or in Rad/Nuc Med Reports (74) RANODE="^RARPT(DA_",R,"
47 ;
48 N RA0,RACNT,RAI,RATCNT,RAXIT,RAY
49 S (RACNT,RATCNT,RAXIT)=0 S RAI=999999999
50 S RAY=$G(@(RANODE_"0)")),RAY(4)=+$P(RAY,"^",4) Q:'RAY(4)
51 F S RAI=$O(@(RANODE_RAI_")"),-1) Q:RAI'>0 D Q:RAXIT
52 . S RA0=$G(@(RANODE_RAI_",0)"))
53 . I RA0?1.999" " D
54 .. K @(RANODE_RAI_",0)") S RACNT=RACNT+1
55 . E S RAXIT=1
56 . Q
57 I RACNT D
58 . S RATCNT=RAY(4)-RACNT
59 . S @(RANODE_"0)")="^^"_RATCNT_"^"_RATCNT_"^"_$S($D(DT)#2:DT,1:$$DT^XLFDT())
60 . Q
61 Q
Note: See TracBrowser for help on using the repository browser.