RADPA.m

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