PSOPST68 ;BIR/RTR-Find Pending orders with no priority ;06/12/01
;;7.0;OUTPATIENT PHARMACY;**68**;DEC 1997
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference ^PS(50.606 supported by DBIA 2174
;
N PSOLOGD,PSOPNPAT,PSOPLOC,PSOPNIN,PSOPNPRI,PSOCOUNT,PSOAORL,PSOAORIN,PSOPNAME,PSOPDIN,PSONOW,X
K ^TMP("PSOCHECK",$J),^TMP("PSOMAILX",$J)
S PSOCOUNT=4,^TMP("PSOMAILX",$J,4)=" "
D NOW^%DTC S PSONOW=%
;loop on AD x-ref, to find oldest orders first
S PSOLOGD=0 F S PSOLOGD=$O(^PS(52.41,"AD",PSOLOGD)) Q:'PSOLOGD!(PSOLOGD>PSONOW) F PSOPLOC=0:0 S PSOPLOC=$O(^PS(52.41,"AD",PSOLOGD,PSOPLOC)) Q:'PSOPLOC F PSOPNIN=0:0 S PSOPNIN=$O(^PS(52.41,"AD",PSOLOGD,PSOPLOC,PSOPNIN)) Q:'PSOPNIN D
.S PSOPNPAT=$P($G(^PS(52.41,PSOPNIN,0)),"^",2) Q:'PSOPNPAT
.I $D(^TMP("PSOCHECK",$J,PSOPNPAT)) Q
.S ^TMP("PSOCHECK",$J,PSOPNPAT)=""
.;loop on AOR x-ref, see if patient has an order without a priority
.F PSOAORL=0:0 S PSOAORL=$O(^PS(52.41,"AOR",PSOPNPAT,PSOAORL)) Q:'PSOAORL F PSOAORIN=0:0 S PSOAORIN=$O(^PS(52.41,"AOR",PSOPNPAT,PSOAORL,PSOAORIN)) Q:'PSOAORIN D
..S PSOPNPRI=$P($G(^PS(52.41,PSOAORIN,0)),"^",3)
..I $P($G(^PS(52.41,PSOAORIN,0)),"^",14)'="" Q
..I PSOPNPRI'="NW",PSOPNPRI'="RNW",PSOPNPRI'="RF" Q
..S PSOPDIN=+$P($G(^PS(52.41,PSOAORIN,0)),"^",2)
..I PSOPDIN'=PSOPNPAT Q
..S PSOPNAME=$P($G(^DPT(PSOPDIN,0)),"^")
..;set mail message with pat.name, drug/ord. item
..S X="" I +$P($G(^PS(52.41,PSOPNIN,0)),"^",9) S X=$P($G(^PSDRUG(+$P($G(^PS(52.41,PSOPNIN,0)),"^",9),0)),"^")
..I X]"" S X="; DRUG: "_X I $O(^PS(52.41,PSOPNIN,1,0))
..E S X="; ORD.ITEM: "_$P($G(^PS(50.7,+$P($G(^PS(52.41,PSOPNIN,0)),"^",8),0)),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
..S PSOCOUNT=PSOCOUNT+1,^TMP("PSOMAILX",$J,PSOCOUNT)="PATIENT NAME: "_$G(PSOPNAME)_X
END ;
;send mail message
S ^TMP("PSOMAILX",$J,1)="A search was done for Pending Outpatient orders",^TMP("PSOMAILX",$J,2)="with no priority assigned. Please review Pending",^TMP("PSOMAILX",$J,3)="orders for the following patients."
I PSOCOUNT=4 S ^TMP("PSOMAILX",$J,5)="None were found in the search."
K XMY
S XMDUZ="PSO*7*68 OUTPATIENT PENDING ORDERS",XMSUB="ORDERS WITHOUT PRIORITY SEARCH"
S XMY(DUZ)=""
S XMTEXT="^TMP(""PSOMAILX"",$J," N DIFROM D ^XMD K XMSUB,XMTEXT,XMY,XMDUZ
K ^TMP("PSOCHECK",$J)
K ^TMP("PSOMAILX",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPST68 2404 printed Dec 13, 2024@02:33:09 Page 2
PSOPST68 ;BIR/RTR-Find Pending orders with no priority ;06/12/01
+1 ;;7.0;OUTPATIENT PHARMACY;**68**;DEC 1997
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External reference to ^PS(50.7 supported by DBIA 2223
+4 ;External reference ^PS(50.606 supported by DBIA 2174
+5 ;
+6 NEW PSOLOGD,PSOPNPAT,PSOPLOC,PSOPNIN,PSOPNPRI,PSOCOUNT,PSOAORL,PSOAORIN,PSOPNAME,PSOPDIN,PSONOW,X
+7 KILL ^TMP("PSOCHECK",$JOB),^TMP("PSOMAILX",$JOB)
+8 SET PSOCOUNT=4
SET ^TMP("PSOMAILX",$JOB,4)=" "
+9 DO NOW^%DTC
SET PSONOW=%
+10 ;loop on AD x-ref, to find oldest orders first
+11 SET PSOLOGD=0
FOR
SET PSOLOGD=$ORDER(^PS(52.41,"AD",PSOLOGD))
if 'PSOLOGD!(PSOLOGD>PSONOW)
QUIT
FOR PSOPLOC=0:0
SET PSOPLOC=$ORDER(^PS(52.41,"AD",PSOLOGD,PSOPLOC))
if 'PSOPLOC
QUIT
FOR PSOPNIN=0:0
SET PSOPNIN=$ORDER(^PS(52.41,"AD",PSOLOGD,PSOPLOC,PSOPNIN))
if 'PSOPNIN
QUIT
Begin DoDot:1
+12 SET PSOPNPAT=$PIECE($GET(^PS(52.41,PSOPNIN,0)),"^",2)
if 'PSOPNPAT
QUIT
+13 IF $DATA(^TMP("PSOCHECK",$JOB,PSOPNPAT))
QUIT
+14 SET ^TMP("PSOCHECK",$JOB,PSOPNPAT)=""
+15 ;loop on AOR x-ref, see if patient has an order without a priority
+16 FOR PSOAORL=0:0
SET PSOAORL=$ORDER(^PS(52.41,"AOR",PSOPNPAT,PSOAORL))
if 'PSOAORL
QUIT
FOR PSOAORIN=0:0
SET PSOAORIN=$ORDER(^PS(52.41,"AOR",PSOPNPAT,PSOAORL,PSOAORIN))
if 'PSOAORIN
QUIT
Begin DoDot:2
+17 SET PSOPNPRI=$PIECE($GET(^PS(52.41,PSOAORIN,0)),"^",3)
+18 IF $PIECE($GET(^PS(52.41,PSOAORIN,0)),"^",14)'=""
QUIT
+19 IF PSOPNPRI'="NW"
IF PSOPNPRI'="RNW"
IF PSOPNPRI'="RF"
QUIT
+20 SET PSOPDIN=+$PIECE($GET(^PS(52.41,PSOAORIN,0)),"^",2)
+21 IF PSOPDIN'=PSOPNPAT
QUIT
+22 SET PSOPNAME=$PIECE($GET(^DPT(PSOPDIN,0)),"^")
+23 ;set mail message with pat.name, drug/ord. item
+24 SET X=""
IF +$PIECE($GET(^PS(52.41,PSOPNIN,0)),"^",9)
SET X=$PIECE($GET(^PSDRUG(+$PIECE($GET(^PS(52.41,PSOPNIN,0)),"^",9),0)),"^")
+25 IF X]""
SET X="; DRUG: "_X
IF $ORDER(^PS(52.41,PSOPNIN,1,0))
+26 IF '$TEST
SET X="; ORD.ITEM: "_$PIECE($GET(^PS(50.7,+$PIECE($GET(^PS(52.41,PSOPNIN,0)),"^",8),0)),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+27 SET PSOCOUNT=PSOCOUNT+1
SET ^TMP("PSOMAILX",$JOB,PSOCOUNT)="PATIENT NAME: "_$GET(PSOPNAME)_X
End DoDot:2
End DoDot:1
END ;
+1 ;send mail message
+2 SET ^TMP("PSOMAILX",$JOB,1)="A search was done for Pending Outpatient orders"
SET ^TMP("PSOMAILX",$JOB,2)="with no priority assigned. Please review Pending"
SET ^TMP("PSOMAILX",$JOB,3)="orders for the following patients."
+3 IF PSOCOUNT=4
SET ^TMP("PSOMAILX",$JOB,5)="None were found in the search."
+4 KILL XMY
+5 SET XMDUZ="PSO*7*68 OUTPATIENT PENDING ORDERS"
SET XMSUB="ORDERS WITHOUT PRIORITY SEARCH"
+6 SET XMY(DUZ)=""
+7 SET XMTEXT="^TMP(""PSOMAILX"",$J,"
NEW DIFROM
DO ^XMD
KILL XMSUB,XMTEXT,XMY,XMDUZ
+8 KILL ^TMP("PSOCHECK",$JOB)
+9 KILL ^TMP("PSOMAILX",$JOB)
+10 QUIT
