Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAORDP

RAORDP.m

Go to the documentation of this file.
RAORDP ;HISC/CAH,FPT AISC/DMK - Log of Pending/Hold Requests ; Aug 25, 2022@07:17:08
 ;;5.0;Radiology/Nuclear Medicine;**15,133,182,193**;Mar 16, 1998;Build 1
 ;
 ; 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")=""
 W !!,"This report requires a 132 column output device." D ZIS^RAUTL G KILL:RAPOP
START ; start report processing
 U IO S QQ="",$P(QQ,"=",132)="=",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),RAOREA=$P(RAO(0),"^",10),RAOPHY=$P(RAO(0),"^",14),RALADT=$P(RAO(0),"^",18),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,RALADT,RAOPHY,RAOREA,RADD,ZTDESC,ZTRTN,ZTSAVE,RALADTX
 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))  D
 .S RAOPHY=0 F  S RAOPHY=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY)) Q:'RAOPHY!($D(RAEOS))  S RALADT=0 F  S RALADT=$O(^(RAOPHY,RALADT)) Q:'RALADT!($D(RAEOS))  D
 ..;p182/KLM Moved RAO $O to new line and removed naked ref as duplicate orders were not picked up
 ..S RAO=0 F  S RAO=$O(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY,RALADT,RAO)) Q:'RAO!($D(RAEOS))  D
 ...N RAOREA S RAOREA=$G(^TMP($J,"RA",RAILOC,RADT,RADFN,RARDT,RAPR,RAOPHY,RALADT,RAO))
 ...S RAORD0=^RAO(75.1,+RAO,0),RACNT=RACNT+1
 ...K RALOCN,RARLOCN
 ...D IPOP^RAUTL13
 ...D WRT
 ...Q
 ..Q
 .Q
 Q
WRT ;
 S Y=RADT D DD^%DT S RADD=Y S Y=$P(RALADT,".") D DD^%DT S RALADTX=Y ;p182/KLM use diff var.
 W !,$S($D(^DPT(RADFN,0)):$E($P(^(0),"^"),1,19),1:"Unknown"),?21,$E($P(^DPT(RADFN,0),"^",9),6,9),?27,$S($D(^RAMIS(71,RAPR,0)):$E($P(^(0),"^"),1,24),1:"Unknown"),?53,$P(RADD,"@")
 S Y=$P(RARDT,".") D DD^%DT W ?67,Y
 W ?81,$S(RAREQSTA=3:RALADTX,1:$E($$GET1^DIQ(200,RAOPHY,.01),1,19))
 I RAREQSTA=3 W ?95,$E($$GET1^DIQ(75.2,RAOREA,.01),1,28)
 E  W ?102,$E(RALOCN,1,28)
 ;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
 ;p193/KLM - next line removed 'scheduled' from header. These are not scheduled requests. Updated column to re-center.
 W !?19,"Includes requests 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",?21,"SSN",?27,"PROCEDURE",?53,"DATE DESIRED",?67,"DATE ORDERED"
 W ?81,$S(RAREQSTA=3:"HOLD DATE",1:"ORDERING PROVIDER")
 I RAREQSTA=3 W ?95,"HOLD REASON",!,QQ,!!
 E  W ?102,"PT LOC",!,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),RAOPHY,RALADT,RAOIFN)=RAOREA 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