RAORDP.m

RAORDP ;HISC/CAH,FPT AISC/DMK-Log of Pending/Hold Requests ;4/17/96  11:28

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

 ;

 ; This report looks at all orders in file 75.1 with status=5 (pending)

 ; or status=3 (hold) and field 21 (Desired Date) within the date range

 ; selected.

 ;

 W !!,"This option will generate a list of requests for a selected date",!,"range with the status of 'PENDING' or 'HOLD'",!

 K DIR S DIR(0)="S^H:HOLD;P:PENDING",DIR("A")="Select REQUEST STATUS",DIR("B")="P" D ^DIR K DIR

 I $D(DIRUT) D KILL Q

 W ! S RAREQSTA=$S(Y="P":5,1:3)

 S RANOSCRN="" D OMA^RAUTL13 K RANOSCRN I '$L($O(RALOC(0)))!($G(RAQUIT)=1) D KILL Q

 S RADDT=1 D DATE^RAUTL K RADDT G KILL:RAPOP S RAOBEG=BEGDATE,RAOEND=ENDDATE+.9 K BEGDATE,ENDDATE

 S ZTRTN="START^RAORDP",ZTSAVE("RALOC(")="",ZTSAVE("RAOBEG")="",ZTSAVE("RAOEND")="",ZTSAVE("RAREQSTA")="" D ZIS^RAUTL G KILL:RAPOP

START ; start report processing

 U IO S QQ="",$P(QQ,"=",80)="=",RALOCNM="",RAOLOC="",RAHDR="LOG OF "_$S(RAREQSTA=5:"PENDING",1:"HOLD")_" REQUESTS",RAHDRDSH="",$P(RAHDRDSH,"-",$L(RAHDR))="-"

 S RAOBEG("X")=+$E(RAOBEG,4,5)_"/"_+$E(RAOBEG,6,7)_"/"_$E(RAOBEG,2,3)

 S RAOEND("X")=+$E(RAOEND,4,5)_"/"_+$E(RAOEND,6,7)_"/"_$E(RAOEND,2,3)

 S X="NOW",%DT="T" D ^%DT D D^RAUTL S RARUNDTE=Y K %DT

 I $D(ZTQUEUED) S ZTREQ="@"

 F  S RALOCNM=$O(RALOC(RALOCNM)) Q:RALOCNM=""  S RA791IEN="" F  S RA791IEN=$O(RALOC(RALOCNM,RA791IEN)) Q:RA791IEN=""  S RALOC1(RA791IEN)=0,RALOCIT(+$P(^RA(79.1,RA791IEN,0),"^",6))=""

 K RALOCNM,RA791IEN S RADFN=0

 F  S RADFN=$O(^RAO(75.1,"AS",RADFN)) Q:'RADFN!($D(RAEOS))  D

 .S RAOIFN=0 F  S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAREQSTA,RAOIFN)) Q:'RAOIFN!($D(RAEOS))  D

 ..I $D(^RAO(75.1,RAOIFN,0)) S RAO(0)=^(0),RAODT=$P(RAO(0),"^",21),RAILOC=$P(RAO(0),"^",20),RAIMTYP=$P(RAO(0),"^",3) D

 ...I $D(RALOC1(+RAILOC)) D SETTMP Q

 ...I RAILOC="",$D(RALOCIT(+RAIMTYP)) D SETTMP

 I $D(RAEOS) D KILL Q

 S RAILOC=""

 F  S RAILOC=$O(RALOC1(RAILOC)) Q:RAILOC=""!($D(RAEOS))  S RACNT=0 D CONT

KILL W !

 K ^TMP($J,"RA")

 K CNT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,I,QQ,RACNT,RADFN,RADDT,RADLOCS,RADT,RAEOS,RAHDR,RAHDRDSH,RAILOC,RAIMTYP,RALOC,RALOC1,RALOCIT

 K RALOCS,RALOCSAV,RALOCN,RAO,RAOBEG,RAODT,RAOEND,RAOIFN,RAOLOC,RAORD0,RAPOP,RAPR,RAQUIT,RARDT,RAREQSTA,BEGDATE,ENDDATE,RARUNDTE

 K X,Y,RAMES,ZTDESC,ZTRTN,ZTSAVE

 D CLOSE^RAUTL

 K POP,DDH,DISYS,DFN,VAERR

 Q

CONT ;

 I $E(IOST,1,2)="C-",RAOLOC]"",RAOLOC'=RAILOC D EOS Q:$D(RAEOS)

 D HDR Q:$D(RAEOS)

 I +RALOC1(RAILOC)=0 W !?2,"No requests "_$S(RAREQSTA=5:"pending",1:"on hold")_" for "_RAOBEG("X")_" to "_RAOEND("X")_".",! I $E(IOST,1,2)="C-"&($O(RALOC1(RAILOC))]"") D EOS Q:$D(RAEOS)  D  Q

 .S RAOLOC(0)=$O(RALOC1(RAILOC)) S:RAOLOC(0)]"" RAOLOC=RAOLOC(0) K RAOLOC(0)

 S RADT=0 F  S RADT=$O(^TMP($J,"RA",RAILOC,RADT)) Q:'RADT!($D(RAEOS))  D DATE S RADFN=0 F  S RADFN=$O(^TMP($J,"RA",RAILOC,RADT,RADFN)) Q:'RADFN!($D(RAEOS))  D MORE

 Q

MORE S RARDT=0 F  S RARDT=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT)) Q:'RARDT!($D(RAEOS))  S RAPR=0 F  S RAPR=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR)) Q:'RAPR!($D(RAEOS))  S RAO=0 F  S RAO=$O(^(RAPR,RAO)) Q:'RAO!($D(RAEOS))  D

 .S RAORD0=^RAO(75.1,+RAO,0),RACNT=RACNT+1

 .K RALOCN,RARLOCN

 .D IPOP^RAUTL13

 .D WRT

 Q

WRT ;

 W !,$S($D(^DPT(RADFN,0)):$E($P(^(0),"^"),1,19)_" -"_$E($P(^(0),"^",9),6,9),1:"Unknown"),?26,$S($D(^RAMIS(71,RAPR,0)):$E($P(^(0),"^"),1,24),1:"Unknown"),?52,$E(RALOCN,1,14)

 S Y=$P(RARDT,".") D DD^%DT W ?67,Y

 I $L($G(RARLOCN)) W !?36,"Requesting Loc: ",RARLOCN

 S RAOLOC=RAILOC

 I ($Y+6)>IOSL D EOS Q:$D(RAEOS)  D:RACNT<RALOC1(RAILOC) HDR Q:$D(RAEOS)  I RACNT=RALOC1(RAILOC) S RAOLOC(0)=$O(RALOC1(RAILOC)) S:RAOLOC(0)]"" RAOLOC=RAOLOC(0) K RAOLOC(0)

 Q

HDR ; header

 W:$Y>0 @IOF

 W !?(80-$L(RAHDR)/2),RAHDR

 W !?14,"Includes requests scheduled from ",RAOBEG("X")," to ",RAOEND("X") ;W !?(80-$L(RAHDR)/2),RAHDRDSH

 W !,"IMAGING LOCATION: ",$S('RAILOC:"Unknown",$D(^RA(79.1,RAILOC,0)):$S($D(^SC($P(^(0),"^"),0)):$P(^(0),"^"),1:"Unknown"),1:"Unknown"),?51,"Run Date: ",RARUNDTE,!

 W !,"PATIENT NAME",?30,"PROCEDURE",?52,"PT LOC",?67,"DATE ORDERED",!,QQ,!

 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=""

 Q

DATE ; Output 'Desired Date'

 S Y=RADT D DD^%DT S X=$L(Y)+32 W !!?(80-X/2),"Desired Date (Time optional): ",Y,!?(80-X/2) S Y="",$P(Y,"-",X)="-" W Y,!

 Q

SETTMP ; set-up ^TMP($J

 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS="" Q:$D(RAEOS)

 I $S('RAODT:0,'RADFN:0,'$P(RAO(0),"^",16):0,'$P(RAO(0),"^",2):0,1:1),RAODT'<RAOBEG,RAODT'>RAOEND S ^TMP($J,"RA",$S(RAILOC:RAILOC,1:"UNKNOWN"),$P(RAO(0),"^",21),RADFN,$P(RAO(0),"^",16),$P(RAO(0),"^",2),RAOIFN)="" D

 .I RAILOC="" S:'$D(RALOC1("UNKNOWN")) RALOC1("UNKNOWN")=0 S RALOC1("UNKNOWN")=RALOC1("UNKNOWN")+1 Q

 .S:RAILOC>0 RALOC1(RAILOC)=RALOC1(RAILOC)+1

 Q

EOS ; end of screen

 S X=$$EOS^RAUTL5

 S:X=1 RAEOS=""

 Q

RAORDP    ;HISC/CAH,FPT AISC/DMK-Log of Pending/Hold Requests ;4/17/96  11:28

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

 +2       ;

 +3       ; This report looks at all orders in file 75.1 with status=5 (pending)

 +4       ; or status=3 (hold) and field 21 (Desired Date) within the date range

 +5       ; selected.

 +6       ;

 +7        WRITE !!,"This option will generate a list of requests for a selected date",!,"range with the status of 'PENDING' or 'HOLD'",!

 +8        KILL DIR

           SET DIR(0)="S^H:HOLD;P:PENDING"

           SET DIR("A")="Select REQUEST STATUS"

           SET DIR("B")="P"

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               DO KILL

               QUIT 

 +10       WRITE !

           SET RAREQSTA=$SELECT(Y="P":5,1:3)

 +11       SET RANOSCRN=""

           DO OMA^RAUTL13

           KILL RANOSCRN

           IF '$LENGTH($ORDER(RALOC(0)))!($GET(RAQUIT)=1)

               DO KILL

               QUIT 

 +12       SET RADDT=1

           DO DATE^RAUTL

           KILL RADDT

           IF RAPOP

               GOTO KILL

           SET RAOBEG=BEGDATE

           SET RAOEND=ENDDATE+.9

           KILL BEGDATE,ENDDATE

 +13       SET ZTRTN="START^RAORDP"

           SET ZTSAVE("RALOC(")=""

           SET ZTSAVE("RAOBEG")=""

           SET ZTSAVE("RAOEND")=""

           SET ZTSAVE("RAREQSTA")=""

           DO ZIS^RAUTL

           IF RAPOP

               GOTO KILL

START     ; start report processing

 +1        USE IO

           SET QQ=""

           SET $PIECE(QQ,"=",80)="="

           SET RALOCNM=""

           SET RAOLOC=""

           SET RAHDR="LOG OF "_$SELECT(RAREQSTA=5:"PENDING",1:"HOLD")_" REQUESTS"

           SET RAHDRDSH=""

           SET $PIECE(RAHDRDSH,"-",$LENGTH(RAHDR))="-"

 +2        SET RAOBEG("X")=+$EXTRACT(RAOBEG,4,5)_"/"_+$EXTRACT(RAOBEG,6,7)_"/"_$EXTRACT(RAOBEG,2,3)

 +3        SET RAOEND("X")=+$EXTRACT(RAOEND,4,5)_"/"_+$EXTRACT(RAOEND,6,7)_"/"_$EXTRACT(RAOEND,2,3)

 +4        SET X="NOW"

           SET %DT="T"

           DO ^%DT

           DO D^RAUTL

           SET RARUNDTE=Y

           KILL %DT

 +5        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +6        FOR 

               SET RALOCNM=$ORDER(RALOC(RALOCNM))

               IF RALOCNM=""

                   QUIT 

               SET RA791IEN=""

               FOR 

                   SET RA791IEN=$ORDER(RALOC(RALOCNM,RA791IEN))

                   IF RA791IEN=""

                       QUIT 

                   SET RALOC1(RA791IEN)=0

                   SET RALOCIT(+$PIECE(^RA(79.1,RA791IEN,0),"^",6))=""

 +7        KILL RALOCNM,RA791IEN

           SET RADFN=0

 +8        FOR 

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

               IF 'RADFN!($DATA(RAEOS))

                   QUIT 

               Begin DoDot:1

 +9                SET RAOIFN=0

                   FOR 

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

                       IF 'RAOIFN!($DATA(RAEOS))

                           QUIT 

                       Begin DoDot:2

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

                               SET RAO(0)=^(0)

                               SET RAODT=$PIECE(RAO(0),"^",21)

                               SET RAILOC=$PIECE(RAO(0),"^",20)

                               SET RAIMTYP=$PIECE(RAO(0),"^",3)

                               Begin DoDot:3

 +11                               IF $DATA(RALOC1(+RAILOC))

                                       DO SETTMP

                                       QUIT 

 +12                               IF RAILOC=""

                                       IF $DATA(RALOCIT(+RAIMTYP))

                                           DO SETTMP

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       IF $DATA(RAEOS)

               DO KILL

               QUIT 

 +14       SET RAILOC=""

 +15       FOR 

               SET RAILOC=$ORDER(RALOC1(RAILOC))

               IF RAILOC=""!($DATA(RAEOS))

                   QUIT 

               SET RACNT=0

               DO CONT

KILL       WRITE !

 +1        KILL ^TMP($JOB,"RA")

 +2        KILL CNT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,I,QQ,RACNT,RADFN,RADDT,RADLOCS,RADT,RAEOS,RAHDR,RAHDRDSH,RAILOC,RAIMTYP,RALOC,RALOC1,RALOCIT

 +3        KILL RALOCS,RALOCSAV,RALOCN,RAO,RAOBEG,RAODT,RAOEND,RAOIFN,RAOLOC,RAORD0,RAPOP,RAPR,RAQUIT,RARDT,RAREQSTA,BEGDATE,ENDDATE,RARUNDTE

 +4        KILL X,Y,RAMES,ZTDESC,ZTRTN,ZTSAVE

 +5        DO CLOSE^RAUTL

 +6        KILL POP,DDH,DISYS,DFN,VAERR

 +7        QUIT 

CONT      ;

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF RAOLOC]""

                   IF RAOLOC'=RAILOC

                       DO EOS

                       IF $DATA(RAEOS)

                           QUIT 

 +2        DO HDR

           IF $DATA(RAEOS)

               QUIT 

 +3        IF +RALOC1(RAILOC)=0

               WRITE !?2,"No requests "_$SELECT(RAREQSTA=5:"pending",1:"on hold")_" for "_RAOBEG("X")_" to "_RAOEND("X")_".",!

               IF $EXTRACT(IOST,1,2)="C-"&($ORDER(RALOC1(RAILOC))]"")

                   DO EOS

                   IF $DATA(RAEOS)

                       QUIT 

                   Begin DoDot:1

 +4                    SET RAOLOC(0)=$ORDER(RALOC1(RAILOC))

                       IF RAOLOC(0)]""

                           SET RAOLOC=RAOLOC(0)

                       KILL RAOLOC(0)

                   End DoDot:1

                   QUIT 

 +5        SET RADT=0

           FOR 

               SET RADT=$ORDER(^TMP($JOB,"RA",RAILOC,RADT))

               IF 'RADT!($DATA(RAEOS))

                   QUIT 

               DO DATE

               SET RADFN=0

               FOR 

                   SET RADFN=$ORDER(^TMP($JOB,"RA",RAILOC,RADT,RADFN))

                   IF 'RADFN!($DATA(RAEOS))

                       QUIT 

                   DO MORE

 +6        QUIT 

MORE       SET RARDT=0

           FOR 

               SET RARDT=$ORDER(^TMP($JOB,"RA",RAILOC,RADT,RADFN,RARDT))

               IF 'RARDT!($DATA(RAEOS))

                   QUIT 

               SET RAPR=0

               FOR 

                   SET RAPR=$ORDER(^TMP($JOB,"RA",RAILOC,RADT,RADFN,RARDT,RAPR))

                   IF 'RAPR!($DATA(RAEOS))

                       QUIT 

                   SET RAO=0

                   FOR 

                       SET RAO=$ORDER(^(RAPR,RAO))

                       IF 'RAO!($DATA(RAEOS))

                           QUIT 

                       Begin DoDot:1

 +1                        SET RAORD0=^RAO(75.1,+RAO,0)

                           SET RACNT=RACNT+1

 +2                        KILL RALOCN,RARLOCN

 +3                        DO IPOP^RAUTL13

 +4                        DO WRT

                       End DoDot:1

 +5        QUIT 

WRT       ;

 +1        WRITE !,$SELECT($DATA(^DPT(RADFN,0)):$EXTRACT($PIECE(^(0),"^"),1,19)_" -"_$EXTRACT($PIECE(^(0),"^",9),6,9),1:"Unknown"),?26,$SELECT($DATA(^RAMIS(71,RAPR,0)):$EXTRACT($PIECE(^(0),"^"),1,24),1:"Unknown"),?52,$EXTRACT(RALOCN,1,14)

 +2        SET Y=$PIECE(RARDT,".")

           DO DD^%DT

           WRITE ?67,Y

 +3        IF $LENGTH($GET(RARLOCN))

               WRITE !?36,"Requesting Loc: ",RARLOCN

 +4        SET RAOLOC=RAILOC

 +5        IF ($Y+6)>IOSL

               DO EOS

               IF $DATA(RAEOS)

                   QUIT 

               IF RACNT<RALOC1(RAILOC)

                   DO HDR

               IF $DATA(RAEOS)

                   QUIT 

               IF RACNT=RALOC1(RAILOC)

                   SET RAOLOC(0)=$ORDER(RALOC1(RAILOC))

                   IF RAOLOC(0)]""

                       SET RAOLOC=RAOLOC(0)

                   KILL RAOLOC(0)

 +6        QUIT 

HDR       ; header

 +1        IF $Y>0

               WRITE @IOF

 +2        WRITE !?(80-$LENGTH(RAHDR)/2),RAHDR

 +3       ;W !?(80-$L(RAHDR)/2),RAHDRDSH

           WRITE !?14,"Includes requests scheduled from ",RAOBEG("X")," to ",RAOEND("X")

 +4        WRITE !,"IMAGING LOCATION: ",$SELECT('RAILOC:"Unknown",$DATA(^RA(79.1,RAILOC,0)):$SELECT($DATA(^SC($PIECE(^(0),"^"),0)):$PIECE(^(0),"^"),1:"Unknown"),1:"Unknown"),?51,"Run Date: ",RARUNDTE,!

 +5        WRITE !,"PATIENT NAME",?30,"PROCEDURE",?52,"PT LOC",?67,"DATE ORDERED",!,QQ,!

 +6        IF $DATA(ZTQUEUED)

               DO STOPCHK^RAUTL9

               IF $GET(ZTSTOP)=1

                   SET RAEOS=""

 +7        QUIT 

DATE      ; Output 'Desired Date'

 +1        SET Y=RADT

           DO DD^%DT

           SET X=$LENGTH(Y)+32

           WRITE !!?(80-X/2),"Desired Date (Time optional): ",Y,!?(80-X/2)

           SET Y=""

           SET $PIECE(Y,"-",X)="-"

           WRITE Y,!

 +2        QUIT 

SETTMP    ; set-up ^TMP($J

 +1        IF $DATA(ZTQUEUED)

               DO STOPCHK^RAUTL9

               IF $GET(ZTSTOP)=1

                   SET RAEOS=""

               IF $DATA(RAEOS)

                   QUIT 

 +2        IF $SELECT('RAODT:0,'RADFN:0,'$PIECE(RAO(0),"^",16):0,'$PIECE(RAO(0),"^",2):0,1:1)

               IF RAODT'<RAOBEG

                   IF RAODT'>RAOEND

                       SET ^TMP($JOB,"RA",$SELECT(RAILOC:RAILOC,1:"UNKNOWN"),$PIECE(RAO(0),"^",21),RADFN,$PIECE(RAO(0),"^",16),$PIECE(RAO(0),"^",2),RAOIFN)=""

                       Begin DoDot:1

 +3                        IF RAILOC=""

                               IF '$DATA(RALOC1("UNKNOWN"))

                                   SET RALOC1("UNKNOWN")=0

                               SET RALOC1("UNKNOWN")=RALOC1("UNKNOWN")+1

                               QUIT 

 +4                        IF RAILOC>0

                               SET RALOC1(RAILOC)=RALOC1(RAILOC)+1

                       End DoDot:1

 +5        QUIT 

EOS       ; end of screen

 +1        SET X=$$EOS^RAUTL5

 +2        IF X=1

               SET RAEOS=""

 +3        QUIT