| [613] | 1 | RAUTL3 ;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
|
|---|
| 3 | EN1 ;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
|
|---|
| 19 | CHK 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
|
|---|
| 21 | SIGNON ;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
|
|---|
| 42 | UPDT(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
|
|---|
