RADPA ;HISC/GJC AISC/MJK,RMO-Look-up Rad/Nuc Med Patients ;4/17/96 11:41
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PAT S Y=-1 Q:'$D(DIC(0))
N RAFLG,RAY S RAFLG=+$G(^DISV(DUZ,"^DPT(")),RAY=0
S:RAFLG>0 ^DISV(DUZ,"^RADPT(")=RAFLG
; If RAOPT("REG") exists, allow addition of new patient to file 70.
; RAOPT("REG") set in entry action of RA REG
I RAFLG,($D(RAOPT("REG"))),('$D(^RADPT("B",RAFLG))) D Q:RAY=-1
. F D Q:RAY=-1!($D(X))
.. R !,"Select Patient: ",X:DTIME
.. S:'$T!(X["^")!(X']"") RAY=-1 Q:RAY=-1
.. I X["?" S X="??",DIC("W")="W """"",DIC(0)="MLEZ" Q
.. I X=" " D Q
... S X=$P($G(^DPT(RAFLG,0)),"^"),DIC("W")="W """"",DIC(0)="MLEZ"
... Q
.. I $L(X)<3!($L(X)>30)!(X?1P.E)!(X'?1A.ANP) D
... W !?5,"Enter patient name in 'Last,First Middle' format [3-30 characters].",$C(7) K X
... Q
.. E S DIC("W")="W """"",DIC(0)="MLEZ"
.. Q
. Q
I '$D(DIC("W")),('$D(^RADPT("B",RAFLG))),($D(RAOPT("REG"))) D
. S DIC(0)="AQELMZ"
. Q
S RAIC(0)=DIC(0),DLAYGO=70,DIC="^RADPT(",DIC("DR")=".06////"_DUZ
S:'$D(DIC("A"))&(DIC(0)["A") DIC("A")="Select Patient: "
W ! D ^DIC K DLAYGO I Y>0 S:RAIC(0)["L" RAPTFL=""
I Y=-1,(X["?"),('$D(^RADPT("B",RAFLG))),($D(RAOPT("REG"))) G PAT
;
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("
K DIC("A"),DIC("DR"),RAIC Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADPA 1493 printed Dec 13, 2024@02:34:50 Page 2
RADPA ;HISC/GJC AISC/MJK,RMO-Look-up Rad/Nuc Med Patients ;4/17/96 11:41
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PAT SET Y=-1
if '$DATA(DIC(0))
QUIT
+1 NEW RAFLG,RAY
SET RAFLG=+$GET(^DISV(DUZ,"^DPT("))
SET RAY=0
+2 if RAFLG>0
SET ^DISV(DUZ,"^RADPT(")=RAFLG
+3 ; If RAOPT("REG") exists, allow addition of new patient to file 70.
+4 ; RAOPT("REG") set in entry action of RA REG
+5 IF RAFLG
IF ($DATA(RAOPT("REG")))
IF ('$DATA(^RADPT("B",RAFLG)))
Begin DoDot:1
+6 FOR
Begin DoDot:2
+7 READ !,"Select Patient: ",X:DTIME
+8 if '$TEST!(X["^")!(X']"")
SET RAY=-1
if RAY=-1
QUIT
+9 IF X["?"
SET X="??"
SET DIC("W")="W """""
SET DIC(0)="MLEZ"
QUIT
+10 IF X=" "
Begin DoDot:3
+11 SET X=$PIECE($GET(^DPT(RAFLG,0)),"^")
SET DIC("W")="W """""
SET DIC(0)="MLEZ"
+12 QUIT
End DoDot:3
QUIT
+13 IF $LENGTH(X)<3!($LENGTH(X)>30)!(X?1P.E)!(X'?1A.ANP)
Begin DoDot:3
+14 WRITE !?5,"Enter patient name in 'Last,First Middle' format [3-30 characters].",$CHAR(7)
KILL X
+15 QUIT
End DoDot:3
+16 IF '$TEST
SET DIC("W")="W """""
SET DIC(0)="MLEZ"
+17 QUIT
End DoDot:2
if RAY=-1!($DATA(X))
QUIT
+18 QUIT
End DoDot:1
if RAY=-1
QUIT
+19 IF '$DATA(DIC("W"))
IF ('$DATA(^RADPT("B",RAFLG)))
IF ($DATA(RAOPT("REG")))
Begin DoDot:1
+20 SET DIC(0)="AQELMZ"
+21 QUIT
End DoDot:1
+22 SET RAIC(0)=DIC(0)
SET DLAYGO=70
SET DIC="^RADPT("
SET DIC("DR")=".06////"_DUZ
+23 if '$DATA(DIC("A"))&(DIC(0)["A")
SET DIC("A")="Select Patient: "
+24 WRITE !
DO ^DIC
KILL DLAYGO
IF Y>0
if RAIC(0)["L"
SET RAPTFL=""
+25 IF Y=-1
IF (X["?")
IF ('$DATA(^RADPT("B",RAFLG)))
IF ($DATA(RAOPT("REG")))
GOTO PAT
+26 ;
Q IF Y>0
IF $DATA(DUZ)'[0
IF DUZ
SET ^DISV(DUZ,"^DPT(")=+Y
if $DATA(^DIC(195.4,1,"RAD"))
SET ^DISV(DUZ,"RT",+^("RAD"))=+Y_";DPT("
+1 KILL DIC("A"),DIC("DR"),RAIC
QUIT
1 SET DIC(0)="AEMQL"
DO PAT
KILL DIC,RAIC
if Y<0
QUIT
SET DIE="^RADPT("
SET DA=+Y
SET DR=".04;.05;1"
DO ^DIE
KILL %,%Y,C,D,D0,DA,DE,DQ,DIE,DR,RAPTFL
QUIT
