- 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
- ;IHS/ANMC/LJF 12/11/98 - removed call where user cannot use chart #
- ; call used last patient user looked up via FM as reason
- ; to force entering name instead of chart # - poor logic
- ;IHS/ANMC/LJF 3/29/2002 - added kill of DIERR to prevent HRCN from
- ; being processed as a DFN
- ;
- 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
- I 0,RAFLG,($D(RA("RA REG"))),('$D(^RADPT("B",RAFLG))) D Q:RAY=-1 ;IHS/ANMC/LJF 12/11/98
- . 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: "
- K DIERR ;IHS/ANMC/LJF 3/29/2002
- 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
- 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
- +2 ;IHS/ANMC/LJF 12/11/98 - removed call where user cannot use chart #
- +3 ; call used last patient user looked up via FM as reason
- +4 ; to force entering name instead of chart # - poor logic
- +5 ;IHS/ANMC/LJF 3/29/2002 - added kill of DIERR to prevent HRCN from
- +6 ; being processed as a DFN
- +7 ;
- 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 ;I RAFLG,($D(RAOPT("REG"))),('$D(^RADPT("B",RAFLG))) D Q:RAY=-1
- +6 ;IHS/ANMC/LJF 12/11/98
- IF 0
- IF RAFLG
- IF ($DATA(RA("RA REG")))
- IF ('$DATA(^RADPT("B",RAFLG)))
- Begin DoDot:1
- +7 FOR
- Begin DoDot:2
- +8 READ !,"Select Patient: ",X:DTIME
- +9 IF '$TEST!(X["^")!(X']"")
- SET RAY=-1
- IF RAY=-1
- QUIT
- +10 IF X["?"
- SET X="??"
- SET DIC("W")="W """""
- SET DIC(0)="MLEZ"
- QUIT
- +11 IF X=" "
- Begin DoDot:3
- +12 SET X=$PIECE($GET(^DPT(RAFLG,0)),"^")
- SET DIC("W")="W """""
- SET DIC(0)="MLEZ"
- +13 QUIT
- End DoDot:3
- QUIT
- +14 IF $LENGTH(X)<3!($LENGTH(X)>30)!(X?1P.E)!(X'?1A.ANP)
- Begin DoDot:3
- +15 WRITE !?5,"Enter patient name in 'Last,First Middle' format [3-30 characters].",$CHAR(7)
- KILL X
- +16 QUIT
- End DoDot:3
- +17 IF '$TEST
- SET DIC("W")="W """""
- SET DIC(0)="MLEZ"
- +18 QUIT
- End DoDot:2
- IF RAY=-1!($DATA(X))
- QUIT
- +19 QUIT
- End DoDot:1
- IF RAY=-1
- QUIT
- +20 IF '$DATA(DIC("W"))
- IF ('$DATA(^RADPT("B",RAFLG)))
- IF ($DATA(RAOPT("REG")))
- Begin DoDot:1
- +21 SET DIC(0)="AQELMZ"
- +22 QUIT
- End DoDot:1
- +23 SET RAIC(0)=DIC(0)
- SET DLAYGO=70
- SET DIC="^RADPT("
- SET DIC("DR")=".06////"_DUZ
- +24 IF '$DATA(DIC("A"))&(DIC(0)["A")
- SET DIC("A")="Select Patient: "
- +25 ;IHS/ANMC/LJF 3/29/2002
- KILL DIERR
- +26 WRITE !
- DO ^DIC
- KILL DLAYGO
- IF Y>0
- IF RAIC(0)["L"
- SET RAPTFL=""
- +27 IF Y=-1
- IF (X["?")
- IF ('$DATA(^RADPT("B",RAFLG)))
- IF ($DATA(RAOPT("REG")))
- GOTO PAT
- +28 ;
- 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
