| 1 | RAORDQ ;HISC/CAH,FPT AISC/RMO-Queue Exam Request ;8/1/97 14:57
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**13,15**;Mar 16, 1998
|
|---|
| 3 | ;S RALOC=$S($D(RALOCFLG):+$P(RAORD0,"^",20),1:+$O(^RA(79,+RADIV,"L",0)))
|
|---|
| 4 | S:$D(RALOCFLG) RALOC=+$P(RAORD0,"^",20)
|
|---|
| 5 | ; Find 1st Imaging Location for Imaging Type, or default to 1st on file.
|
|---|
| 6 | I '$D(RALOCFLG) D S:RALOC="" RALOC=+$O(^RA(79,+RADIV,"L",0))
|
|---|
| 7 | .S RALOC=""
|
|---|
| 8 | .F S RALOC=$O(^RA(79.1,"BIMG",RAIMGTYI,RALOC)) Q:RALOC="" I $P(^RA(79.1,RALOC,0),U,16)]"",^RA(79.1,RALOC,"DIV")=+RADIV Q
|
|---|
| 9 | S RAREQPRT=$S($D(^RA(79.1,+RALOC,0)):$P(^(0),"^",16),1:"")
|
|---|
| 10 | Q:RAREQPRT']""
|
|---|
| 11 | S RAREQPRT=$P($G(^%ZIS(1,RAREQPRT,0)),"^") Q:RAREQPRT']""
|
|---|
| 12 | S RAGMTS=+$P($G(^RAMIS(71,+$P($G(^RAO(75.1,RAOIFN,0)),"^",2),0)),"^",13)
|
|---|
| 13 | S RAHSMULT(RAGMTS,RADFN)=+$G(RAHSMULT(RAGMTS,RADFN))+1
|
|---|
| 14 | S ION=RAREQPRT,IOP="Q;"_ION,ZTSAVE("RADFN")="",ZTSAVE("RAOIFN")=""
|
|---|
| 15 | S ZTSAVE("RALOC")="",ZTSAVE("RAGMTS")="",ZTSAVE("RAHSMULT(")=""
|
|---|
| 16 | S:$D(RAOPT) ZTSAVE("RAOPT(")="" S:$D(RAFOERR) ZTSAVE("RAFOERR")=""
|
|---|
| 17 | S ZTDTH=$H,ZTRTN="PRTORD^RAORDQ"
|
|---|
| 18 | S:'$D(RAMES) RAMES="W !?5,""...request has been submitted to "",ION,""."",!"
|
|---|
| 19 | D ZIS^RAUTL K IOP,RALOC,RAREQPRT
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | PRTORD ; Print Health Summary if applicable
|
|---|
| 23 | ; RAORD0 is defined in RAORD5
|
|---|
| 24 | U IO S RAX="",RAPGE=0 D ^RAORD5
|
|---|
| 25 | S GMTSTYP=RAGMTS
|
|---|
| 26 | I GMTSTYP>0,($G(RAHSMULT(RAGMTS,RADFN))'>1) D
|
|---|
| 27 | . W:$Y>0 @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
|
|---|
| 28 | . Q
|
|---|
| 29 | K RAOIFN,RAPGE,RAX
|
|---|
| 30 | I GMTSTYP>0,($G(RAHSMULT(RAGMTS,RADFN))'>1) K GMTSTYP,RADFN Q
|
|---|
| 31 | K GMTSTYP,RADFN W ! D CLOSE^RAUTL
|
|---|
| 32 | Q
|
|---|
| 33 | OERR ;OERR ENTRY POINT TO PRINT/DISPLAY A RAD/NUC MED REPORT
|
|---|
| 34 | F RAI=0:0 S RAI=$O(RADUP(RAI)) Q:RAI'>0 S X=^TMP($J,"RAEX",RAI),RADUP(RAI)=$P(X,"^",10)_"^"_$P(X,"^",8)
|
|---|
| 35 | S ZTSAVE("RADUP(")="",ZTRTN="DQ^RAORDQ",ZTDESC="Print Rad/Nuc Med Reports" D ZIS^RAUTL G Q:RAPOP I IO=IO(0) D OERR^RART1 G Q
|
|---|
| 36 | DQ U IO F RAI1=0:0 S RAI1=$O(RADUP(RAI1)) Q:RAI1'>0 S RARPT=+RADUP(RAI1),RACN=$P(RADUP(RAI1),"^",2) D CHK^RART1 D:$D(RARPT) ^RARTR
|
|---|
| 37 | Q I $D(RAMIE) F RAI1=0:0 S RAI1=$O(^RA(78.7,RAI1)) Q:RAI1'>0 I $D(^(RAI1,0)) K @$P(^(0),"^",5)
|
|---|
| 38 | K RAI1,RADUP,RACN,RARPT,RAPOP D:'$D(RAMIE) CLOSE^RAUTL Q
|
|---|
