PSOPST68.m

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

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