source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADPA.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: 1.4 KB
Line 
1RADPA ;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
3PAT 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 ;
30Q 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
321 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
Note: See TracBrowser for help on using the repository browser.