RAORDS.m

RAORDS ;HISC/CAH,DAD AISC/RMO-Select Patient's Requests ;6/7/00  16:34

 ;;5.0;Radiology/Nuclear Medicine;**15,21**;Mar 16, 1998

 Q:'$D(RADFN)  D HOME^%ZIS K ^TMP($J,"RAORDS"),RAOUT,RAORDS

 K ^TMP($J,"PRO-ORD"),^TMP($J,"PRO-REG")

 ; ^tmp($j,"pro-ord",proc-ien,order-ien) -- outstanding orders

 ; ^tmp($j,"pro-reg",proc-ien,order-ien) -- actually regist'd procs

 S ^TMP($J,"RAORDS","Unknown")=""

 S (RACNT,RASEQ,RAPARENT)=0,RAOSTSYM="dc^c^h^^p^^^s"

 K RAOSTSNM S X(1)=^DD(75.1,5,0) F I=1:1 S RAOSTS=$P(RAOVSTS,";",I) Q:RAOSTS=""  S X=$P($P(X(1),RAOSTS_":",2),";"),RAOSTSNM=$S('$D(RAOSTSNM):X,1:RAOSTSNM_", "_X)

 F RALP=1:1 S RAOSTS=$P(RAOVSTS,";",RALP) Q:RAOSTS=""  F RAOIFN=0:0 S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN)) Q:'RAOIFN  I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) D SETUTL

 I '$D(^TMP($J,"RAORDS"))!('RACNT) W !!?5,"No requests available to select for this patient.",! G Q

 F RAOURG=0:0 S RAOURG=$O(^TMP($J,"RAORDS",RAOURG)) Q:'RAOURG!($D(RAOSEL))  F RAODTI=0:0 S RAODTI=$O(^TMP($J,"RAORDS",RAOURG,RAODTI)) Q:'RAODTI!($D(RAOSEL))  D CHKORD

 ;

Q K ^TMP($J,"RAORDS"),RACNT,RACNT1,RADASH,RADUP,RAERR,RAI,RALCTN,RALOC

 K RALP,RANUM,RAOASTS,RAODTE,RAODTI,RAOFNS,RAOIFN,RAOIFNS,RAORD0,RAOSEL

 K RAOSTS,RAOSTSNM,RAOSTSYM,RAOURG,RAOVSTS,RAPHY,RAPAR,RAPRC,RAREQ

 K RASEL,RASEQ,RAX

 Q

 ;

SETUTL ; Check if option is to be screened.  If yes, apply the screen.

 I $P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P",$O(^RAMIS(71,+$P(RAORD0,U,2),4,0))'>0 Q  ; Parent without descendents

 I $D(RAVSTFLG)#2,$P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P" Q  ; Cannot choose parent in add exams option

 I $D(RASCREEN) D  Q:'$D(^TMP($J,"RA L-TYPE",RALCTN))

 . S RALCTN=+$P(RAORD0,"^",20)

 . S:'RALCTN RALCTN="Unknown" Q:RALCTN="Unknown"

 . S RALCTN=$S($D(^RA(79.1,RALCTN,0)):+$P(^(0),"^"),1:"Unknown")

 . Q:RALCTN="Unknown"

 . S RALCTN=$S($D(^SC(RALCTN,0)):$P(^(0),"^"),1:"Unknown")

 . Q

 S RACNT=RACNT+1,^TMP($J,"RAORDS",$S('$P(RAORD0,"^",6):9,1:$P(RAORD0,"^",6)),9999999.9999-$S($P(RAORD0,"^",21):$P(RAORD0,"^",21),1:$P(RAORD0,"^",16)),RAOIFN,RACNT)=RAORD0

 ; store order's indiv procedures

 I $P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)'="P" S ^TMP($J,"PRO-ORD",$S($P(RAORD0,U,2):$P(RAORD0,U,2),1:0),RAOIFN)="" Q

 ; for parent orders, must store each descendant's proc ien

 S RA6=+$P(RAORD0,U,2),RA7=0

 F  S RA7=$O(^RAMIS(71,RA6,4,RA7)) Q:'RA7  S ^TMP($J,"PRO-ORD",+$P($G(^(RA7,0)),U),RAOIFN)="DESC"

 Q

 ;

CHKORD F RAOIFN=0:0 S RAOIFN=$O(^TMP($J,"RAORDS",RAOURG,RAODTI,RAOIFN)) Q:'RAOIFN!($D(RAOSEL))  F RACNT1=0:0 S RACNT1=$O(^TMP($J,"RAORDS",RAOURG,RAODTI,RAOIFN,RACNT1)) Q:RACNT1'>0!($D(RAOSEL))  S RAORD0=^(RACNT1) D PRTORD

 Q

 ;

PRTORD D HD:'(RASEQ#8) Q:$D(RAOSEL)  S RASEQ=RASEQ+1,RAOIFNS(RASEQ)=RAOIFN,RAPRC=$S($D(^RAMIS(71,+$P(RAORD0,"^",2),0)):$P(^(0),"^"),1:"Unknown"),RAODTE=9999999.9999-RAODTI

 S RAPHY=$S($D(^VA(200,+$P(RAORD0,"^",14),0)):$P(^(0),"^"),1:"Unknown"),RALOC=$S($D(^SC(+$P(RAORD0,"^",22),0)):$P(^(0),"^"),1:"Unknown")

 N RA6 S RA6=$S($P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P"&($P($G(^(0)),U,18)="Y"):"+",1:"") ;parent proc and single rpt

 W !,$J(RASEQ,2),?4,$P(RAOSTSYM,"^",+$P(RAORD0,"^",5)),?8,$E($P($P(^DD(75.1,6,0),RAOURG_":",2),";"),1,7),?16,RA6

 W ?17,$E(RAPRC,1,25),?44,$E(RAODTE,4,5)_"/"_$E(RAODTE,6,7)_"/"_(1700+$E(RAODTE,1,3)),?56,$E(RAPHY,1,11),?69,$E(RALOC,1,11)

 W !?17,"(",$S($P(RAORD0,U,20)="":"UNKNOWN",1:$E($P($G(^SC(+$G(^RA(79.1,+$P(RAORD0,U,20),0)),0)),U),1,23)),")"

 D ASKSEL:RACNT=RASEQ

 Q

 ;

HD D ASKSEL:RASEQ Q:$D(RAOSEL)  W @IOF,!?16,"**** Requested Exams for ",$E(RANME,1,20)," ****",?65,$J(RACNT,3),?70,"Requests"

 W !?4,"St",?8,"Urgency",?17,"Procedure / (Img. Loc.)",?44,"Desired",?56,"Requester",?69,"Req'g Loc",!?4,"--",?8,"-------",?17,"-------------------------",?44,"----------",?56,"-----------",?69,"-----------"

 Q

 ;

ASKSEL K RADUP,RAORDS S (RAERR,RAI,RANUM)=0

 W:$D(RAOPT("REG")) !!,"(Use  Pn  to replace request 'n' with a Printset procedure.)"

 W:'$D(RAOPT("REG")) !

 W !,"Select Request(s) 1-",RASEQ,$S($D(RAOFNS):" to "_RAOFNS,1:"")," or '^' to Exit:  ",$S(RASEQ<RACNT:"Continue",1:"Exit"),"// " R X:DTIME S:'$T X="^",RAOUT="" S:X["^" RAOSEL=0 Q:X["^"!(X="")

 S RAX=X I RAX["?" W !!?3,"Please select the request(s) you want separated by commas or a range",!?3,"of numbers separated by a dash, or a combination of commas and dashes." D HLPSEL G ASKSEL

PARSE I $$UP^XLFSTR(RAX)?1"P".N D DPAR Q  ; detail-to-parent

 S RAI=RAI+1,RAPAR=$P(RAX,",",RAI) Q:RAPAR=""  I RAPAR?.N1"-".N S RADASH="" F RASEL=$P(RAPAR,"-"):1:$P(RAPAR,"-",2) D CHKSEL Q:RAERR

 I '$D(RADASH) S RASEL=RAPAR D CHKSEL

 K RADASH G ASKSEL:RAERR,PARSE

 ;

CHKSEL I $D(RADASH),+$P(RAPAR,"-",2)<+$P(RAPAR,"-") S RAERR=1 Q

 I RASEL'?.N W !?3,*7,"Item ",RASEL," is not a valid selection." S RAERR=1 Q

 I '$D(RAOIFNS(RASEL)) W !?3,*7,"Item ",RASEL," is not a valid selection." S RAERR=1 Q

 I $D(RADUP(RASEL)) W !?3,*7,"Item ",RASEL," was already selected." S RAERR=1 Q

 I $D(^RAO(75.1,+(RAOIFNS(RASEL)),0)),RAOVSTS'[$P(^(0),"^",5) W !?3,*7,"Item ",RASEL," does not have a valid status for this option.",!?3,"Valid statuses are ",RAOSTSNM,"." S RAERR=1 Q

 I RAPARENT,$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2),0)),U,6)="P",('$D(RAOPT("ORDERPRINTPAT"))) D  S RAERR=1,RAPARENT=0 Q  ; Two parents chosen

 . ; check NOT valid during 'Print Selected Requests by Patient' option!

 . W !!?3,*7,"Only one parent type procedure may be chosen at a time."

 . W !?3,"(You have already chosen ",$P($G(^RAMIS(71,RAPARENT,0)),U),".)"

 . Q

 S RANUM=RANUM+1,RADUP(RASEL)="",RAORDS(RANUM)=RAOIFNS(RASEL),RAOSEL=RANUM

 I $P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2),0)),U,6)="P" D

 . S RAPARENT=+$P($G(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2)

 . Q

 Q

 ;

HLPSEL I $D(RAOSTSNM) W !!?3,"The request(s) must have one of the following statuses",$S($D(RAOFNS):" to "_RAOFNS,1:""),":",!?6,RAOSTSNM

 I RAX["??" W !!?3,"Status Symbols:  'dc' - discontinued   'c' - complete   'h' - on hold",!?20,"'p'  - pending        ' ' - active     's' - scheduled"

 Q

DPAR ; convert detail proc to parent

 S RASEL=$E(RAX,2,$L(RAX)) ; remove leading 'P'

 S:RASEL="" RASEL="P" ;set to 1 char so chksel will reject it

 D CHKSEL

 ; if order's proc is a parent, then --

 ;   1-kill raords to skip exam^rareg1

 ;   2-don't kill raosel so chkord loop would stop

 I RAPARENT W !!?3,*7,"Only Detailed, Series, and Broad procedures can be selected !",! K RAORDS Q

 Q:RAX="P"  ;entry is only a single P, so don't flag

 S RADPARFL=1 ; flag

RAORDS    ;HISC/CAH,DAD AISC/RMO-Select Patient's Requests ;6/7/00  16:34

 +1       ;;5.0;Radiology/Nuclear Medicine;**15,21**;Mar 16, 1998

 +2        IF '$DATA(RADFN)

               QUIT 

           DO HOME^%ZIS

           KILL ^TMP($JOB,"RAORDS"),RAOUT,RAORDS

 +3        KILL ^TMP($JOB,"PRO-ORD"),^TMP($JOB,"PRO-REG")

 +4       ; ^tmp($j,"pro-ord",proc-ien,order-ien) -- outstanding orders

 +5       ; ^tmp($j,"pro-reg",proc-ien,order-ien) -- actually regist'd procs

 +6        SET ^TMP($JOB,"RAORDS","Unknown")=""

 +7        SET (RACNT,RASEQ,RAPARENT)=0

           SET RAOSTSYM="dc^c^h^^p^^^s"

 +8        KILL RAOSTSNM

           SET X(1)=^DD(75.1,5,0)

           FOR I=1:1

               SET RAOSTS=$PIECE(RAOVSTS,";",I)

               IF RAOSTS=""

                   QUIT 

               SET X=$PIECE($PIECE(X(1),RAOSTS_":",2),";")

               SET RAOSTSNM=$SELECT('$DATA(RAOSTSNM):X,1:RAOSTSNM_", "_X)

 +9        FOR RALP=1:1

               SET RAOSTS=$PIECE(RAOVSTS,";",RALP)

               IF RAOSTS=""

                   QUIT 

               FOR RAOIFN=0:0

                   SET RAOIFN=$ORDER(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN))

                   IF 'RAOIFN

                       QUIT 

                   IF $DATA(^RAO(75.1,RAOIFN,0))

                       SET RAORD0=^(0)

                       DO SETUTL

 +10       IF '$DATA(^TMP($JOB,"RAORDS"))!('RACNT)

               WRITE !!?5,"No requests available to select for this patient.",!

               GOTO Q

 +11       FOR RAOURG=0:0

               SET RAOURG=$ORDER(^TMP($JOB,"RAORDS",RAOURG))

               IF 'RAOURG!($DATA(RAOSEL))

                   QUIT 

               FOR RAODTI=0:0

                   SET RAODTI=$ORDER(^TMP($JOB,"RAORDS",RAOURG,RAODTI))

                   IF 'RAODTI!($DATA(RAOSEL))

                       QUIT 

                   DO CHKORD

 +12      ;

Q          KILL ^TMP($JOB,"RAORDS"),RACNT,RACNT1,RADASH,RADUP,RAERR,RAI,RALCTN,RALOC

 +1        KILL RALP,RANUM,RAOASTS,RAODTE,RAODTI,RAOFNS,RAOIFN,RAOIFNS,RAORD0,RAOSEL

 +2        KILL RAOSTS,RAOSTSNM,RAOSTSYM,RAOURG,RAOVSTS,RAPHY,RAPAR,RAPRC,RAREQ

 +3        KILL RASEL,RASEQ,RAX

 +4        QUIT 

 +5       ;

SETUTL    ; Check if option is to be screened.  If yes, apply the screen.

 +1       ; Parent without descendents

           IF $PIECE($GET(^RAMIS(71,+$PIECE(RAORD0,U,2),0)),U,6)="P"

               IF $ORDER(^RAMIS(71,+$PIECE(RAORD0,U,2),4,0))'>0

                   QUIT 

 +2       ; Cannot choose parent in add exams option

           IF $DATA(RAVSTFLG)#2

               IF $PIECE($GET(^RAMIS(71,+$PIECE(RAORD0,U,2),0)),U,6)="P"

                   QUIT 

 +3        IF $DATA(RASCREEN)

               Begin DoDot:1

 +4                SET RALCTN=+$PIECE(RAORD0,"^",20)

 +5                IF 'RALCTN

                       SET RALCTN="Unknown"

                   IF RALCTN="Unknown"

                       QUIT 

 +6                SET RALCTN=$SELECT($DATA(^RA(79.1,RALCTN,0)):+$PIECE(^(0),"^"),1:"Unknown")

 +7                IF RALCTN="Unknown"

                       QUIT 

 +8                SET RALCTN=$SELECT($DATA(^SC(RALCTN,0)):$PIECE(^(0),"^"),1:"Unknown")

 +9                QUIT 

               End DoDot:1

               IF '$DATA(^TMP($JOB,"RA L-TYPE",RALCTN))

                   QUIT 

 +10       SET RACNT=RACNT+1

           SET ^TMP($JOB,"RAORDS",$SELECT('$PIECE(RAORD0,"^",6):9,1:$PIECE(RAORD0,"^",6)),9999999.9999-$SELECT($PIECE(RAORD0,"^",21):$PIECE(RAORD0,"^",21),1:$PIECE(RAORD0,"^",16)),RAOIFN,RACNT)=RAORD0

 +11      ; store order's indiv procedures

 +12       IF $PIECE($GET(^RAMIS(71,+$PIECE(RAORD0,U,2),0)),U,6)'="P"

               SET ^TMP($JOB,"PRO-ORD",$SELECT($PIECE(RAORD0,U,2):$PIECE(RAORD0,U,2),1:0),RAOIFN)=""

               QUIT 

 +13      ; for parent orders, must store each descendant's proc ien

 +14       SET RA6=+$PIECE(RAORD0,U,2)

           SET RA7=0

 +15       FOR 

               SET RA7=$ORDER(^RAMIS(71,RA6,4,RA7))

               IF 'RA7

                   QUIT 

               SET ^TMP($JOB,"PRO-ORD",+$PIECE($GET(^(RA7,0)),U),RAOIFN)="DESC"

 +16       QUIT 

 +17      ;

CHKORD     FOR RAOIFN=0:0

               SET RAOIFN=$ORDER(^TMP($JOB,"RAORDS",RAOURG,RAODTI,RAOIFN))

               IF 'RAOIFN!($DATA(RAOSEL))

                   QUIT 

               FOR RACNT1=0:0

                   SET RACNT1=$ORDER(^TMP($JOB,"RAORDS",RAOURG,RAODTI,RAOIFN,RACNT1))

                   IF RACNT1'>0!($DATA(RAOSEL))

                       QUIT 

                   SET RAORD0=^(RACNT1)

                   DO PRTORD

 +1        QUIT 

 +2       ;

PRTORD     IF '(RASEQ#8)

               DO HD

           IF $DATA(RAOSEL)

               QUIT 

           SET RASEQ=RASEQ+1

           SET RAOIFNS(RASEQ)=RAOIFN

           SET RAPRC=$SELECT($DATA(^RAMIS(71,+$PIECE(RAORD0,"^",2),0)):$PIECE(^(0),"^"),1:"Unknown")

           SET RAODTE=9999999.9999-RAODTI

 +1        SET RAPHY=$SELECT($DATA(^VA(200,+$PIECE(RAORD0,"^",14),0)):$PIECE(^(0),"^"),1:"Unknown")

           SET RALOC=$SELECT($DATA(^SC(+$PIECE(RAORD0,"^",22),0)):$PIECE(^(0),"^"),1:"Unknown")

 +2       ;parent proc and single rpt

           NEW RA6

           SET RA6=$SELECT($PIECE($GET(^RAMIS(71,+$PIECE(RAORD0,U,2),0)),U,6)="P"&($PIECE($GET(^(0)),U,18)="Y"):"+",1:"")

 +3        WRITE !,$JUSTIFY(RASEQ,2),?4,$PIECE(RAOSTSYM,"^",+$PIECE(RAORD0,"^",5)),?8,$EXTRACT($PIECE($PIECE(^DD(75.1,6,0),RAOURG_":",2),";"),1,7),?16,RA6

 +4        WRITE ?17,$EXTRACT(RAPRC,1,25),?44,$EXTRACT(RAODTE,4,5)_"/"_$EXTRACT(RAODTE,6,7)_"/"_(1700+$EXTRACT(RAODTE,1,3)),?56,$EXTRACT(RAPHY,1,11),?69,$EXTRACT(RALOC,1,11)

 +5        WRITE !?17,"(",$SELECT($PIECE(RAORD0,U,20)="":"UNKNOWN",1:$EXTRACT($PIECE($GET(^SC(+$GET(^RA(79.1,+$PIECE(RAORD0,U,20),0)),0)),U),1,23)),")"

 +6        IF RACNT=RASEQ

               DO ASKSEL

 +7        QUIT 

 +8       ;

HD         IF RASEQ

               DO ASKSEL

           IF $DATA(RAOSEL)

               QUIT 

           WRITE @IOF,!?16,"**** Requested Exams for ",$EXTRACT(RANME,1,20)," ****",?65,$JUSTIFY(RACNT,3),?70,"Requests"

 +1        WRITE !?4,"St",?8,"Urgency",?17,"Procedure / (Img. Loc.)",?44,"Desired",?56,"Requester",?69,"Req'g Loc",!?4,"--",?8,"-------",?17,"-------------------------",?44,"----------",?56,"-----------",?69,"-----------"

 +2        QUIT 

 +3       ;

ASKSEL     KILL RADUP,RAORDS

           SET (RAERR,RAI,RANUM)=0

 +1        IF $DATA(RAOPT("REG"))

               WRITE !!,"(Use  Pn  to replace request 'n' with a Printset procedure.)"

 +2        IF '$DATA(RAOPT("REG"))

               WRITE !

 +3        WRITE !,"Select Request(s) 1-",RASEQ,$SELECT($DATA(RAOFNS):" to "_RAOFNS,1:"")," or '^' to Exit:  ",$SELECT(RASEQ<RACNT:"Continue",1:"Exit"),"// "

           READ X:DTIME

           IF '$TEST

               SET X="^"

               SET RAOUT=""

           IF X["^"

               SET RAOSEL=0

           IF X["^"!(X="")

               QUIT 

 +4        SET RAX=X

           IF RAX["?"

               WRITE !!?3,"Please select the request(s) you want separated by commas or a range",!?3,"of numbers separated by a dash, or a combination of commas and dashes."

               DO HLPSEL

               GOTO ASKSEL

PARSE     ; detail-to-parent

           IF $$UP^XLFSTR(RAX)?1"P".N

               DO DPAR

               QUIT 

 +1        SET RAI=RAI+1

           SET RAPAR=$PIECE(RAX,",",RAI)

           IF RAPAR=""

               QUIT 

           IF RAPAR?.N1"-".N

               SET RADASH=""

               FOR RASEL=$PIECE(RAPAR,"-"):1:$PIECE(RAPAR,"-",2)

                   DO CHKSEL

                   IF RAERR

                       QUIT 

 +2        IF '$DATA(RADASH)

               SET RASEL=RAPAR

               DO CHKSEL

 +3        KILL RADASH

           IF RAERR

               GOTO ASKSEL

           GOTO PARSE

 +4       ;

CHKSEL     IF $DATA(RADASH)

               IF +$PIECE(RAPAR,"-",2)<+$PIECE(RAPAR,"-")

                   SET RAERR=1

                   QUIT 

 +1        IF RASEL'?.N

               WRITE !?3,*7,"Item ",RASEL," is not a valid selection."

               SET RAERR=1

               QUIT 

 +2        IF '$DATA(RAOIFNS(RASEL))

               WRITE !?3,*7,"Item ",RASEL," is not a valid selection."

               SET RAERR=1

               QUIT 

 +3        IF $DATA(RADUP(RASEL))

               WRITE !?3,*7,"Item ",RASEL," was already selected."

               SET RAERR=1

               QUIT 

 +4        IF $DATA(^RAO(75.1,+(RAOIFNS(RASEL)),0))

               IF RAOVSTS'[$PIECE(^(0),"^",5)

                   WRITE !?3,*7,"Item ",RASEL," does not have a valid status for this option.",!?3,"Valid statuses are ",RAOSTSNM,"."

                   SET RAERR=1

                   QUIT 

 +5       ; Two parents chosen

           IF RAPARENT

               IF $PIECE($GET(^RAMIS(71,+$PIECE($GET(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2),0)),U,6)="P"

                   IF ('$DATA(RAOPT("ORDERPRINTPAT")))

                       Begin DoDot:1

 +6       ; check NOT valid during 'Print Selected Requests by Patient' option!

 +7                        WRITE !!?3,*7,"Only one parent type procedure may be chosen at a time."

 +8                        WRITE !?3,"(You have already chosen ",$PIECE($GET(^RAMIS(71,RAPARENT,0)),U),".)"

 +9                        QUIT 

                       End DoDot:1

                       SET RAERR=1

                       SET RAPARENT=0

                       QUIT 

 +10       SET RANUM=RANUM+1

           SET RADUP(RASEL)=""

           SET RAORDS(RANUM)=RAOIFNS(RASEL)

           SET RAOSEL=RANUM

 +11       IF $PIECE($GET(^RAMIS(71,+$PIECE($GET(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2),0)),U,6)="P"

               Begin DoDot:1

 +12               SET RAPARENT=+$PIECE($GET(^RAO(75.1,+RAOIFNS(RASEL),0)),U,2)

 +13               QUIT 

               End DoDot:1

 +14       QUIT 

 +15      ;

HLPSEL     IF $DATA(RAOSTSNM)

               WRITE !!?3,"The request(s) must have one of the following statuses",$SELECT($DATA(RAOFNS):" to "_RAOFNS,1:""),":",!?6,RAOSTSNM

 +1        IF RAX["??"

               WRITE !!?3,"Status Symbols:  'dc' - discontinued   'c' - complete   'h' - on hold",!?20,"'p'  - pending        ' ' - active     's' - scheduled"

 +2        QUIT 

DPAR      ; convert detail proc to parent

 +1       ; remove leading 'P'

           SET RASEL=$EXTRACT(RAX,2,$LENGTH(RAX))

 +2       ;set to 1 char so chksel will reject it

           IF RASEL=""

               SET RASEL="P"

 +3        DO CHKSEL

 +4       ; if order's proc is a parent, then --

 +5       ;   1-kill raords to skip exam^rareg1

 +6       ;   2-don't kill raosel so chkord loop would stop

 +7        IF RAPARENT

               WRITE !!?3,*7,"Only Detailed, Series, and Broad procedures can be selected !",!

               KILL RAORDS

               QUIT 

 +8       ;entry is only a single P, so don't flag

           IF RAX="P"

               QUIT 

 +9       ; flag

           SET RADPARFL=1