- PSXTNRPT ;BIR/WPB-Routine to Provide Turnaround Reports at Host & Remote Facilities ; 04/08/97 2:06 PM
- ;;2.0;CMOP;**45**;11 Apr 97
- REMOTE S FLAG=1
- R1 W !! S %DT="AEX",%DT("A")="Enter Begin Date for Report: ",%DT(0)="-NOW",%DT("B")="TODAY" D ^%DT G:Y<0!($D(DTOUT)) EXIT S BB=Y,BEG=$$FMADD^XLFDT(BB,-1,0,0,0)_".9999"
- W !! S %DT("A")="Enter End Date for Report: " D ^%DT K %DT G:Y<0!($D(DTOUT)) EXIT S EE=Y,END=EE_".9999"
- K %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
- I BB>EE W !,"Beginning date must be before ending date." G REMOTE
- Q:$G(FLAG)=0
- DEVICE S %ZIS="Q",%ZIS("B")="" D ^%ZIS S PSXLION=ION G:POP EXIT I $G(IOST)["C-" W !,"You must select a printer." G DEVICE
- I $D(IO("Q")) D QUE,EXIT Q
- D:$G(FLAG)=1 REMOTE1
- D:$G(FLAG)=0 HOST1
- G EXIT
- QUE S ZTRTN=$S($G(FLAG)=1:"REMOTE1^PSXTNRPT",$G(FLAG)=0:"HOST1^PSXTNRPT",1:""),ZTIO=PSXLION,ZTSAVE("BB")="",ZTSAVE("BEG")="",ZTSAVE("EE")="",ZTSAVE("END")="",ZTDESC="CMOP Turn Around Report"
- S:$G(FLAG)=0 ZTSAVE("SNAME")="",ZTSAVE("SITE")="" D ^%ZTLOAD
- I $D(ZTSK)[0 W !!,"Job Canceled"
- E W !!,"Job Queued"
- D HOME^%ZIS
- Q
- ;Called by Taskman to begin Turnaround report for Remote
- REMOTE1 U IO S (LTT,STT,CNT,CNTA,AVTTM,TURN,TOTTM)=0
- F S BEG=$O(^PSRX("AR",BEG)) Q:(BEG'>0)!(BEG>END) S RX=0 F S RX=$O(^PSRX("AR",BEG,RX)) Q:RX'>0 S FILL="" F S FILL=$O(^PSRX("AR",BEG,RX,FILL)) Q:FILL="" D
- .Q:'$O(^PSRX(RX,4,0))
- .S RXTTM=0
- .S XX=0 F S XX=$O(^PSRX(RX,4,XX)) Q:XX'>0 S:$P($G(^PSRX(RX,4,XX,0)),"^",3)=FILL BAT=$P($G(^PSRX(RX,4,XX,0)),"^",1),STAT=$P(^PSRX(RX,4,XX,0),"^",4)
- .Q:STAT'=1
- .I $G(FILL)>0 S:'$D(^PSRX(RX,1,FILL,0)) CNTA=CNTA+1
- .S TTM=$P($G(^PSX(550.2,BAT,0)),"^",6)
- .S TURN=$$FMDIFF^XLFDT(BEG,TTM,2)
- .S:LTT<TURN LRX=RX S:LTT<TURN LTT=TURN S:STT=0 STT=TURN S:STT>TURN!(STT=TURN) SRX=RX S:STT>TURN STT=TURN S TOTTM=TOTTM+TURN
- .S CNT=CNT+1
- .S:CNT=1 LRX=RX
- G:CNT'>0 RPT1
- S AVTTM=TOTTM/CNT
- S LTT=$P($$STHMS^PSXTNRPT(LTT),"."),STT=$P($$STHMS^PSXTNRPT(STT),"."),AVTTM=$$STHMS^PSXTNRPT($P(AVTTM,"."))
- I IOST["C-" W @IOF
- RPT1 W !!!,"TURNAROUND TIME FOR PERIOD"
- W !,$$FMTE^XLFDT(BB,"1P")," - ",$$FMTE^XLFDT(EE,"1P")
- I $G(CNT)=0 W !,"No Rx's completed during this period." G EXIT
- W !!,"Total Rx's Completed : ",CNT
- W !,"Maximum turnaround time: ",LTT," Rx: ",$P(^PSRX(LRX,0),"^",1)
- W !,"Minimum turnaround time: ",STT," Rx: ",$P(^PSRX(SRX,0),"^",1)
- W !,"Average turnaround time: ",AVTTM
- I $G(CNTA)>0 W !!,"Number of Rx's missing refill node: ",CNTA
- EXIT W @IOF
- D ^%ZISC
- K AVT,BB,BEG,CMDT,CNT,EE,END,PTR514,SITE,SNAME,ST,TDT,TOTTM,XX,YY,LT,PSXLION,XS,CNTA,DIC,DTOUT,DUOUT,FLAG,AVRTM,AVTTM,BAT,FILL,LRT,LTT,RTURN,RX,RXRTM,TTM,RXTTM,SRT,STAT,STT,TRTM,TURN,X,Y,LRX,SRX,%DT,%ZIS,FLAG
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HOST S FLAG=0
- D R1 Q:$G(FLAG)=""
- W !! S DIC=552,DIC(0)="AEQMZ",DIC("A")="Enter site: " D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT))!(Y<0) EXIT S XS=$P(Y,"^",2),SNAME=Y(0,0),FACDA=+Y K X,Y
- S SITE=$$GET1^DIQ(552,FACDA,5) K FACDA
- I SITE="" S SITE=$P(^DIC(4,XS,99),"^",1)
- D DEVICE
- Q
- ;Called by Taskman to begin Turnaround report for HOST
- HOST1 U IO S (LT,ST,AVT,CNT,CNTA,TOTTM)=0
- F S BEG=$O(^PSX(552.4,"AD",BEG)) Q:(BEG'>0)!(BEG>EE) S XX=0 F S XX=$O(^PSX(552.4,"AD",BEG,XX)) Q:XX'>0 S YY=0 F S YY=$O(^PSX(552.4,"AD",BEG,XX,YY)) Q:YY'>0 D
- .S PTR514=$P(^PSX(552.4,XX,0),"^",1)
- .Q:$P($P(^PSX(552.1,PTR514,0),"^",1),"-",1)'=SITE
- .Q:$P($G(^PSX(552.4,XX,1,YY,0)),"^",2)=2
- .Q:$P($G(^PSX(552.4,XX,1,YY,2)),"^",2)'=""
- .S:$P(^PSX(552.4,XX,1,YY,0),"^",10)=2 CNTA=CNTA+1
- .S (TDT,CMDT)=0,CNT=CNT+1
- .S CMDT=$P(^PSX(552.4,XX,1,YY,0),"^",9),TDT=$P(^PSX(552.1,PTR514,0),"^",3)
- .S TT=$$FMDIFF^XLFDT(CMDT,TDT,2) S:TT>LT LRX=$P(^PSX(552.4,XX,1,YY,0),"^",1) S:TT>LT LT=TT S:ST=0 ST=TT S:(TT<ST)!(ST=TT) SRX=$P(^PSX(552.4,XX,1,YY,0),"^",1),ST=TT
- .S TOTTM=TOTTM+TT
- .S:CNT=1 LRX=$P(^PSX(552.4,XX,1,YY,0),"^",1)
- .K TT
- G:CNT'>0 RPT
- S AVT=TOTTM/CNT
- RPT I IOST["C-" W @IOF
- W !!!,"TURNAROUND TIME REPORT FOR "_SNAME
- W !,"FOR "_$$FMTE^XLFDT(BB,"1P")," - ",$$FMTE^XLFDT(EE,"1P")
- I $G(CNT)=0 W !!,"No Rx's completed during this time period." G EXIT
- W !!,"Total Rx's Completed : ",CNT
- I $G(CNTA)>0 W !,"Number of Rx's not processed at remote: ",CNTA
- W !,"Maximum turnaround time: ",$P($$STHMS^PSXTNRPT(LT),".")," Rx: ",LRX
- W !,"Minimum turnaround time: ",$P($$STHMS^PSXTNRPT(ST),".")," Rx: ",SRX
- W !,"Average turnaround time: ",$P($$STHMS^PSXTNRPT(AVT),"."),!
- G EXIT
- STHMS(X) ;
- Q:(X<1)!(X="") 0
- N XX,YY,X1,X2,X3,Y1,Y2,Y3,T1,U1,E1,R1,W1
- S XX=X/3600,X1=$P(XX,".",1),X2=X1*3600,X3=X-X2,YY=X3/60,Y1=$P(YY,".",1),Y2=Y1*60,Y3=X3-Y2 S:X1>24 T1=(X1/24),U1=$P(T1,".",1),E1=(X1-(U1*24)),X1=E1
- S R1=$S($G(U1)>0:U1_" days ",1:"")_$S($G(X1)>0:X1_" hrs ",1:"")_$S($G(Y1)>0:Y1_" mins ",1:"")_$S($G(Y3)>0:Y3_" secs",1:"")
- K XX,YY,X1,X2,X3,Y1,Y2,Y3,T1,U1,E1,W1
- Q R1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXTNRPT 4847 printed Mar 13, 2025@20:49:59 Page 2
- PSXTNRPT ;BIR/WPB-Routine to Provide Turnaround Reports at Host & Remote Facilities ; 04/08/97 2:06 PM
- +1 ;;2.0;CMOP;**45**;11 Apr 97
- REMOTE SET FLAG=1
- R1 WRITE !!
- SET %DT="AEX"
- SET %DT("A")="Enter Begin Date for Report: "
- SET %DT(0)="-NOW"
- SET %DT("B")="TODAY"
- DO ^%DT
- if Y<0!($DATA(DTOUT))
- GOTO EXIT
- SET BB=Y
- SET BEG=$$FMADD^XLFDT(BB,-1,0,0,0)_".9999"
- +1 WRITE !!
- SET %DT("A")="Enter End Date for Report: "
- DO ^%DT
- KILL %DT
- if Y<0!($DATA(DTOUT))
- GOTO EXIT
- SET EE=Y
- SET END=EE_".9999"
- +2 KILL %DT("A"),%DT("B"),%DT(0),Y,X,DTOUT
- +3 IF BB>EE
- WRITE !,"Beginning date must be before ending date."
- GOTO REMOTE
- +4 if $GET(FLAG)=0
- QUIT
- DEVICE SET %ZIS="Q"
- SET %ZIS("B")=""
- DO ^%ZIS
- SET PSXLION=ION
- if POP
- GOTO EXIT
- IF $GET(IOST)["C-"
- WRITE !,"You must select a printer."
- GOTO DEVICE
- +1 IF $DATA(IO("Q"))
- DO QUE
- DO EXIT
- QUIT
- +2 if $GET(FLAG)=1
- DO REMOTE1
- +3 if $GET(FLAG)=0
- DO HOST1
- +4 GOTO EXIT
- QUE SET ZTRTN=$SELECT($GET(FLAG)=1:"REMOTE1^PSXTNRPT",$GET(FLAG)=0:"HOST1^PSXTNRPT",1:"")
- SET ZTIO=PSXLION
- SET ZTSAVE("BB")=""
- SET ZTSAVE("BEG")=""
- SET ZTSAVE("EE")=""
- SET ZTSAVE("END")=""
- SET ZTDESC="CMOP Turn Around Report"
- +1 if $GET(FLAG)=0
- SET ZTSAVE("SNAME")=""
- SET ZTSAVE("SITE")=""
- DO ^%ZTLOAD
- +2 IF $DATA(ZTSK)[0
- WRITE !!,"Job Canceled"
- +3 IF '$TEST
- WRITE !!,"Job Queued"
- +4 DO HOME^%ZIS
- +5 QUIT
- +6 ;Called by Taskman to begin Turnaround report for Remote
- REMOTE1 USE IO
- SET (LTT,STT,CNT,CNTA,AVTTM,TURN,TOTTM)=0
- +1 FOR
- SET BEG=$ORDER(^PSRX("AR",BEG))
- if (BEG'>0)!(BEG>END)
- QUIT
- SET RX=0
- FOR
- SET RX=$ORDER(^PSRX("AR",BEG,RX))
- if RX'>0
- QUIT
- SET FILL=""
- FOR
- SET FILL=$ORDER(^PSRX("AR",BEG,RX,FILL))
- if FILL=""
- QUIT
- Begin DoDot:1
- +2 if '$ORDER(^PSRX(RX,4,0))
- QUIT
- +3 SET RXTTM=0
- +4 SET XX=0
- FOR
- SET XX=$ORDER(^PSRX(RX,4,XX))
- if XX'>0
- QUIT
- if $PIECE($GET(^PSRX(RX,4,XX,0)),"^",3)=FILL
- SET BAT=$PIECE($GET(^PSRX(RX,4,XX,0)),"^",1)
- SET STAT=$PIECE(^PSRX(RX,4,XX,0),"^",4)
- +5 if STAT'=1
- QUIT
- +6 IF $GET(FILL)>0
- if '$DATA(^PSRX(RX,1,FILL,0))
- SET CNTA=CNTA+1
- +7 SET TTM=$PIECE($GET(^PSX(550.2,BAT,0)),"^",6)
- +8 SET TURN=$$FMDIFF^XLFDT(BEG,TTM,2)
- +9 if LTT<TURN
- SET LRX=RX
- if LTT<TURN
- SET LTT=TURN
- if STT=0
- SET STT=TURN
- if STT>TURN!(STT=TURN)
- SET SRX=RX
- if STT>TURN
- SET STT=TURN
- SET TOTTM=TOTTM+TURN
- +10 SET CNT=CNT+1
- +11 if CNT=1
- SET LRX=RX
- End DoDot:1
- +12 if CNT'>0
- GOTO RPT1
- +13 SET AVTTM=TOTTM/CNT
- +14 SET LTT=$PIECE($$STHMS^PSXTNRPT(LTT),".")
- SET STT=$PIECE($$STHMS^PSXTNRPT(STT),".")
- SET AVTTM=$$STHMS^PSXTNRPT($PIECE(AVTTM,"."))
- +15 IF IOST["C-"
- WRITE @IOF
- RPT1 WRITE !!!,"TURNAROUND TIME FOR PERIOD"
- +1 WRITE !,$$FMTE^XLFDT(BB,"1P")," - ",$$FMTE^XLFDT(EE,"1P")
- +2 IF $GET(CNT)=0
- WRITE !,"No Rx's completed during this period."
- GOTO EXIT
- +3 WRITE !!,"Total Rx's Completed : ",CNT
- +4 WRITE !,"Maximum turnaround time: ",LTT," Rx: ",$PIECE(^PSRX(LRX,0),"^",1)
- +5 WRITE !,"Minimum turnaround time: ",STT," Rx: ",$PIECE(^PSRX(SRX,0),"^",1)
- +6 WRITE !,"Average turnaround time: ",AVTTM
- +7 IF $GET(CNTA)>0
- WRITE !!,"Number of Rx's missing refill node: ",CNTA
- EXIT WRITE @IOF
- +1 DO ^%ZISC
- +2 KILL AVT,BB,BEG,CMDT,CNT,EE,END,PTR514,SITE,SNAME,ST,TDT,TOTTM,XX,YY,LT,PSXLION,XS,CNTA,DIC,DTOUT,DUOUT,FLAG,AVRTM,AVTTM,BAT,FILL,LRT,LTT,RTURN,RX,RXRTM,TTM,RXTTM,SRT,STAT,STT,TRTM,TURN,X,Y,LRX,SRX,%DT,%ZIS,FLAG
- +3 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 QUIT
- HOST SET FLAG=0
- +1 DO R1
- if $GET(FLAG)=""
- QUIT
- +2 WRITE !!
- SET DIC=552
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Enter site: "
- DO ^DIC
- KILL DIC
- if $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
- GOTO EXIT
- SET XS=$PIECE(Y,"^",2)
- SET SNAME=Y(0,0)
- SET FACDA=+Y
- KILL X,Y
- +3 SET SITE=$$GET1^DIQ(552,FACDA,5)
- KILL FACDA
- +4 IF SITE=""
- SET SITE=$PIECE(^DIC(4,XS,99),"^",1)
- +5 DO DEVICE
- +6 QUIT
- +7 ;Called by Taskman to begin Turnaround report for HOST
- HOST1 USE IO
- SET (LT,ST,AVT,CNT,CNTA,TOTTM)=0
- +1 FOR
- SET BEG=$ORDER(^PSX(552.4,"AD",BEG))
- if (BEG'>0)!(BEG>EE)
- QUIT
- SET XX=0
- FOR
- SET XX=$ORDER(^PSX(552.4,"AD",BEG,XX))
- if XX'>0
- QUIT
- SET YY=0
- FOR
- SET YY=$ORDER(^PSX(552.4,"AD",BEG,XX,YY))
- if YY'>0
- QUIT
- Begin DoDot:1
- +2 SET PTR514=$PIECE(^PSX(552.4,XX,0),"^",1)
- +3 if $PIECE($PIECE(^PSX(552.1,PTR514,0),"^",1),"-",1)'=SITE
- QUIT
- +4 if $PIECE($GET(^PSX(552.4,XX,1,YY,0)),"^",2)=2
- QUIT
- +5 if $PIECE($GET(^PSX(552.4,XX,1,YY,2)),"^",2)'=""
- QUIT
- +6 if $PIECE(^PSX(552.4,XX,1,YY,0),"^",10)=2
- SET CNTA=CNTA+1
- +7 SET (TDT,CMDT)=0
- SET CNT=CNT+1
- +8 SET CMDT=$PIECE(^PSX(552.4,XX,1,YY,0),"^",9)
- SET TDT=$PIECE(^PSX(552.1,PTR514,0),"^",3)
- +9 SET TT=$$FMDIFF^XLFDT(CMDT,TDT,2)
- if TT>LT
- SET LRX=$PIECE(^PSX(552.4,XX,1,YY,0),"^",1)
- if TT>LT
- SET LT=TT
- if ST=0
- SET ST=TT
- if (TT<ST)!(ST=TT)
- SET SRX=$PIECE(^PSX(552.4,XX,1,YY,0),"^",1)
- SET ST=TT
- +10 SET TOTTM=TOTTM+TT
- +11 if CNT=1
- SET LRX=$PIECE(^PSX(552.4,XX,1,YY,0),"^",1)
- +12 KILL TT
- End DoDot:1
- +13 if CNT'>0
- GOTO RPT
- +14 SET AVT=TOTTM/CNT
- RPT IF IOST["C-"
- WRITE @IOF
- +1 WRITE !!!,"TURNAROUND TIME REPORT FOR "_SNAME
- +2 WRITE !,"FOR "_$$FMTE^XLFDT(BB,"1P")," - ",$$FMTE^XLFDT(EE,"1P")
- +3 IF $GET(CNT)=0
- WRITE !!,"No Rx's completed during this time period."
- GOTO EXIT
- +4 WRITE !!,"Total Rx's Completed : ",CNT
- +5 IF $GET(CNTA)>0
- WRITE !,"Number of Rx's not processed at remote: ",CNTA
- +6 WRITE !,"Maximum turnaround time: ",$PIECE($$STHMS^PSXTNRPT(LT),".")," Rx: ",LRX
- +7 WRITE !,"Minimum turnaround time: ",$PIECE($$STHMS^PSXTNRPT(ST),".")," Rx: ",SRX
- +8 WRITE !,"Average turnaround time: ",$PIECE($$STHMS^PSXTNRPT(AVT),"."),!
- +9 GOTO EXIT
- STHMS(X) ;
- +1 if (X<1)!(X="")
- QUIT 0
- +2 NEW XX,YY,X1,X2,X3,Y1,Y2,Y3,T1,U1,E1,R1,W1
- +3 SET XX=X/3600
- SET X1=$PIECE(XX,".",1)
- SET X2=X1*3600
- SET X3=X-X2
- SET YY=X3/60
- SET Y1=$PIECE(YY,".",1)
- SET Y2=Y1*60
- SET Y3=X3-Y2
- if X1>24
- SET T1=(X1/24)
- SET U1=$PIECE(T1,".",1)
- SET E1=(X1-(U1*24))
- SET X1=E1
- +4 SET R1=$SELECT($GET(U1)>0:U1_" days ",1:"")_$SELECT($GET(X1)>0:X1_" hrs ",1:"")_$SELECT($GET(Y1)>0:Y1_" mins ",1:"")_$SELECT($GET(Y3)>0:Y3_" secs",1:"")
- +5 KILL XX,YY,X1,X2,X3,Y1,Y2,Y3,T1,U1,E1,W1
- +6 QUIT R1
