PSAOP3.m

PSAOP3 ;BIR/LTL,JMB-Nightly Background Job ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 ;This is the entry point to gather outpatient pharmacy dispensing data

 ;for all drugs in all pharmacy locations. When the drug is released in

 ;outpatient, an ^XTMP("PSA") global is set to contain the dispensing

 ;data. It is called by PSAPSI3.

 ;^XTMP("PSA",59.7 OP Site#,50 Drug#,Date dispensed)=Total Qty Dispensed

 ;

 N PSA,PSADRUG,PSALOC ;PSA=OP SITE, PSA(1)=DRUG(IEN), PSA(2)=DT

LUP S PSA=0 F  S PSA=$O(^XTMP("PSA",PSA)) Q:'PSA  D

 .S PSA(1)=0 F  S PSA(1)=$O(^XTMP("PSA",PSA,PSA(1))) Q:'PSA(1)  D

 ..S PSA(2)=0 F  S PSA(2)=$O(^XTMP("PSA",PSA,PSA(1),PSA(2))) Q:'PSA(2)  D

 ...S PSALOC=$O(^PSD(58.8,"AOP",PSA,0)),PSADRUG=PSA(1)

 ...;PSA*3*21 (due to multiple OP locations, check for Inactive - Dave B)

 ...I $P($G(^PSD(58.8,PSALOC,7,PSA,0)),"^",2)'="" Q

 ...S PSA(3)=$G(^XTMP("PSA",PSA,PSA(1),PSA(2)))

 ...D:$D(^PSD(58.8,+PSALOC,1,PSADRUG))&($P($G(^PSD(58.8,+PSALOC,0)),U,2)="P") ^PSAOP1

 ...K ^XTMP("PSA",PSA,PSA(1),PSA(2))

 S X1=DT,X2=7 D C^%DTC S ^XTMP("PSA",0)=X_"^"_DT_"^Drug Accountability Dispensing Data"

QUIT Q

PSAOP3    ;BIR/LTL,JMB-Nightly Background Job ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 +2       ;This is the entry point to gather outpatient pharmacy dispensing data

 +3       ;for all drugs in all pharmacy locations. When the drug is released in

 +4       ;outpatient, an ^XTMP("PSA") global is set to contain the dispensing

 +5       ;data. It is called by PSAPSI3.

 +6       ;^XTMP("PSA",59.7 OP Site#,50 Drug#,Date dispensed)=Total Qty Dispensed

 +7       ;

 +8       ;PSA=OP SITE, PSA(1)=DRUG(IEN), PSA(2)=DT

           NEW PSA,PSADRUG,PSALOC

LUP        SET PSA=0

           FOR 

               SET PSA=$ORDER(^XTMP("PSA",PSA))

               IF 'PSA

                   QUIT 

               Begin DoDot:1

 +1                SET PSA(1)=0

                   FOR 

                       SET PSA(1)=$ORDER(^XTMP("PSA",PSA,PSA(1)))

                       IF 'PSA(1)

                           QUIT 

                       Begin DoDot:2

 +2                        SET PSA(2)=0

                           FOR 

                               SET PSA(2)=$ORDER(^XTMP("PSA",PSA,PSA(1),PSA(2)))

                               IF 'PSA(2)

                                   QUIT 

                               Begin DoDot:3

 +3                                SET PSALOC=$ORDER(^PSD(58.8,"AOP",PSA,0))

                                   SET PSADRUG=PSA(1)

 +4       ;PSA*3*21 (due to multiple OP locations, check for Inactive - Dave B)

 +5                                IF $PIECE($GET(^PSD(58.8,PSALOC,7,PSA,0)),"^",2)'=""

                                       QUIT 

 +6                                SET PSA(3)=$GET(^XTMP("PSA",PSA,PSA(1),PSA(2)))

 +7                                IF $DATA(^PSD(58.8,+PSALOC,1,PSADRUG))&($PIECE($GET(^PSD(58.8,+PSALOC,0)),U,2)="P")

                                       DO ^PSAOP1

 +8                                KILL ^XTMP("PSA",PSA,PSA(1),PSA(2))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +9        SET X1=DT

           SET X2=7

           DO C^%DTC

           SET ^XTMP("PSA",0)=X_"^"_DT_"^Drug Accountability Dispensing Data"

QUIT       QUIT