| 1 | RADPA ;HISC/GJC AISC/MJK,RMO-Look-up Rad/Nuc Med Patients ;4/17/96 11:41
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | PAT S Y=-1 Q:'$D(DIC(0))
|
|---|
| 4 | N RAFLG,RAY S RAFLG=+$G(^DISV(DUZ,"^DPT(")),RAY=0
|
|---|
| 5 | S:RAFLG>0 ^DISV(DUZ,"^RADPT(")=RAFLG
|
|---|
| 6 | ; If RAOPT("REG") exists, allow addition of new patient to file 70.
|
|---|
| 7 | ; RAOPT("REG") set in entry action of RA REG
|
|---|
| 8 | I RAFLG,($D(RAOPT("REG"))),('$D(^RADPT("B",RAFLG))) D Q:RAY=-1
|
|---|
| 9 | . F D Q:RAY=-1!($D(X))
|
|---|
| 10 | .. R !,"Select Patient: ",X:DTIME
|
|---|
| 11 | .. S:'$T!(X["^")!(X']"") RAY=-1 Q:RAY=-1
|
|---|
| 12 | .. I X["?" S X="??",DIC("W")="W """"",DIC(0)="MLEZ" Q
|
|---|
| 13 | .. I X=" " D Q
|
|---|
| 14 | ... S X=$P($G(^DPT(RAFLG,0)),"^"),DIC("W")="W """"",DIC(0)="MLEZ"
|
|---|
| 15 | ... Q
|
|---|
| 16 | .. I $L(X)<3!($L(X)>30)!(X?1P.E)!(X'?1A.ANP) D
|
|---|
| 17 | ... W !?5,"Enter patient name in 'Last,First Middle' format [3-30 characters].",$C(7) K X
|
|---|
| 18 | ... Q
|
|---|
| 19 | .. E S DIC("W")="W """"",DIC(0)="MLEZ"
|
|---|
| 20 | .. Q
|
|---|
| 21 | . Q
|
|---|
| 22 | I '$D(DIC("W")),('$D(^RADPT("B",RAFLG))),($D(RAOPT("REG"))) D
|
|---|
| 23 | . S DIC(0)="AQELMZ"
|
|---|
| 24 | . Q
|
|---|
| 25 | S RAIC(0)=DIC(0),DLAYGO=70,DIC="^RADPT(",DIC("DR")=".06////"_DUZ
|
|---|
| 26 | S:'$D(DIC("A"))&(DIC(0)["A") DIC("A")="Select Patient: "
|
|---|
| 27 | W ! D ^DIC K DLAYGO I Y>0 S:RAIC(0)["L" RAPTFL=""
|
|---|
| 28 | I Y=-1,(X["?"),('$D(^RADPT("B",RAFLG))),($D(RAOPT("REG"))) G PAT
|
|---|
| 29 | ;
|
|---|
| 30 | Q I Y>0,$D(DUZ)'[0,DUZ S ^DISV(DUZ,"^DPT(")=+Y S:$D(^DIC(195.4,1,"RAD")) ^DISV(DUZ,"RT",+^("RAD"))=+Y_";DPT("
|
|---|
| 31 | K DIC("A"),DIC("DR"),RAIC Q
|
|---|
| 32 | 1 S DIC(0)="AEMQL" D PAT K DIC,RAIC Q:Y<0 S DIE="^RADPT(",DA=+Y,DR=".04;.05;1" D ^DIE K %,%Y,C,D,D0,DA,DE,DQ,DIE,DR,RAPTFL Q
|
|---|
