PSDMAPU.m

PSDMAPU ;BIR/JPW-Stock Missing CS Appl. Pkg. Use ; 22 Jun 93

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)

 S PSDUZ=DUZ D NOW^%DTC S PSDT=X

DEV ;sets queueing information

 S ZTIO="",ZTRTN="START^PSDMAPU",ZTDESC="CS PHARM NON-CS DRUG BACKGROUND JOB" S (ZTSAVE("PSDUZ"),ZTSAVE("PSDT"),ZTSAVE("PSDSITE"))="" D ^%ZTLOAD K ZTSK G END

START ;queued entry point to check for non-CS entries in file 50

 K ^TMP("PSDAPU",$J)

 F PSDA=0:0 S PSDA=$O(^PSD(58.8,PSDA)) Q:'PSDA  I $D(^PSD(58.8,PSDA,0)),$S($P(^(0),"^",2)'="P":1,1:0),$S('$D(^("I")):1,'+^("I"):1,+^("I")>DT:1,1:0) D

 .Q:$P($G(^PSD(58.8,PSDA,0)),"^",3)'=+PSDSITE

 .F PSDR=0:0 S PSDR=$O(^PSD(58.8,PSDA,1,PSDR)) Q:'PSDR  Q:'$D(^PSD(58.8,PSDA,1,PSDR,0))  D

 ..S OK=$S($P($G(^PSDRUG(PSDR,2)),"^",3)["N":1,1:0) Q:OK

 ..I $P($G(^PSD(58.8,PSDA,1,PSDR,0)),"^",14)="" K DA,DIE,DR S DA(1)=PSDA,DA=PSDR,DIE="^PSD(58.8,"_PSDA_",1,",DR="13///"_PSDT_";14////O;14.5////NON-CS DRUG" D ^DIE K DIE D

 ...S NAOU=$S($P(^PSD(58.8,PSDA,0),"^")]"":$P(^(0),"^"),1:"NAME MISSING"),PSDRN=$S($P(^PSDRUG(PSDR,0),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING"),^TMP("PSDAPU",$J,PSDRN,NAOU)=""

MSG ;send mailman message with completed info

 K XMY,^TMP("PSDMAPU",$J) S MLN=1

 I '$D(^TMP("PSDAPU",$J)) S ^TMP("PSDMAPU",$J,MLN,0)="   THERE ARE NO CS DRUGS STOCKED IN ANY NAOUS WHICH HAVE BEEN",MLN=MLN+1,^TMP("PSDMAPU",$J,MLN,0)="   UNMARKED FOR CS USE "

 I $D(^TMP("PSDAPU",$J)) S NN="" F  S NN=$O(^TMP("PSDAPU",$J,NN)) Q:NN=""  S ^TMP("PSDMAPU",$J,MLN,0)=NN_" was inactivated in the following NAOU(s):",JJ="" F  S JJ=$O(^TMP("PSDAPU",$J,NN,JJ)) Q:JJ=""  D

 .S MLN=MLN+1,^TMP("PSDMAPU",$J,MLN,0)="  "_JJ

 S XMSUB="CS PHARM NON-CS DRUG SUMMARY",XMDUZ="CONTROLLED SUBSTANCES PHARMACY",XMTEXT="^TMP(""PSDMAPU"",$J,",XMY(PSDUZ)="" S:'$D(XMY) XMY(.5)=""

 D ^XMD K XMY,^TMP("PSDMAPU",$J)

END K %,%DT,%H,%I,DA,DIE,DR,JJ,MLN,NAOU,NN,OK,PSDA,PSDR,PSDRN,PSDT,PSDUZ,X,XMSUB,XMDUZ,XMTEXT,XMY,Y,^TMP("PSDAPU",$J)

 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK S:$D(ZTQUEUED) ZTREQ="@"

PSDMAPU   ;BIR/JPW-Stock Missing CS Appl. Pkg. Use ; 22 Jun 93

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   QUIT 

 +3        SET PSDUZ=DUZ

           DO NOW^%DTC

           SET PSDT=X

DEV       ;sets queueing information

 +1        SET ZTIO=""

           SET ZTRTN="START^PSDMAPU"

           SET ZTDESC="CS PHARM NON-CS DRUG BACKGROUND JOB"

           SET (ZTSAVE("PSDUZ"),ZTSAVE("PSDT"),ZTSAVE("PSDSITE"))=""

           DO ^%ZTLOAD

           KILL ZTSK

           GOTO END

START     ;queued entry point to check for non-CS entries in file 50

 +1        KILL ^TMP("PSDAPU",$JOB)

 +2        FOR PSDA=0:0

               SET PSDA=$ORDER(^PSD(58.8,PSDA))

               IF 'PSDA

                   QUIT 

               IF $DATA(^PSD(58.8,PSDA,0))

                   IF $SELECT($PIECE(^(0),"^",2)'="P":1,1:0)

                       IF $SELECT('$DATA(^("I")):1,'+^("I"):1,+^("I")>DT:1,1:0)

                           Begin DoDot:1

 +3                            IF $PIECE($GET(^PSD(58.8,PSDA,0)),"^",3)'=+PSDSITE

                                   QUIT 

 +4                            FOR PSDR=0:0

                                   SET PSDR=$ORDER(^PSD(58.8,PSDA,1,PSDR))

                                   IF 'PSDR

                                       QUIT 

                                   IF '$DATA(^PSD(58.8,PSDA,1,PSDR,0))

                                       QUIT 

                                   Begin DoDot:2

 +5                                    SET OK=$SELECT($PIECE($GET(^PSDRUG(PSDR,2)),"^",3)["N":1,1:0)

                                       IF OK

                                           QUIT 

 +6                                    IF $PIECE($GET(^PSD(58.8,PSDA,1,PSDR,0)),"^",14)=""

                                           KILL DA,DIE,DR

                                           SET DA(1)=PSDA

                                           SET DA=PSDR

                                           SET DIE="^PSD(58.8,"_PSDA_",1,"

                                           SET DR="13///"_PSDT_";14////O;14.5////NON-CS DRUG"

                                           DO ^DIE

                                           KILL DIE

                                           Begin DoDot:3

 +7                                            SET NAOU=$SELECT($PIECE(^PSD(58.8,PSDA,0),"^")]"":$PIECE(^(0),"^"),1:"NAME MISSING")

                                               SET PSDRN=$SELECT($PIECE(^PSDRUG(PSDR,0),"^")]"":$PIECE(^(0),"^"),1:"DRUG NAME MISSING")

                                               SET ^TMP("PSDAPU",$JOB,PSDRN,NAOU)=""

                                           End DoDot:3

                                   End DoDot:2

                           End DoDot:1

MSG       ;send mailman message with completed info

 +1        KILL XMY,^TMP("PSDMAPU",$JOB)

           SET MLN=1

 +2        IF '$DATA(^TMP("PSDAPU",$JOB))

               SET ^TMP("PSDMAPU",$JOB,MLN,0)="   THERE ARE NO CS DRUGS STOCKED IN ANY NAOUS WHICH HAVE BEEN"

               SET MLN=MLN+1

               SET ^TMP("PSDMAPU",$JOB,MLN,0)="   UNMARKED FOR CS USE "

 +3        IF $DATA(^TMP("PSDAPU",$JOB))

               SET NN=""

               FOR 

                   SET NN=$ORDER(^TMP("PSDAPU",$JOB,NN))

                   IF NN=""

                       QUIT 

                   SET ^TMP("PSDMAPU",$JOB,MLN,0)=NN_" was inactivated in the following NAOU(s):"

                   SET JJ=""

                   FOR 

                       SET JJ=$ORDER(^TMP("PSDAPU",$JOB,NN,JJ))

                       IF JJ=""

                           QUIT 

                       Begin DoDot:1

 +4                        SET MLN=MLN+1

                           SET ^TMP("PSDMAPU",$JOB,MLN,0)="  "_JJ

                       End DoDot:1

 +5        SET XMSUB="CS PHARM NON-CS DRUG SUMMARY"

           SET XMDUZ="CONTROLLED SUBSTANCES PHARMACY"

           SET XMTEXT="^TMP(""PSDMAPU"",$J,"

           SET XMY(PSDUZ)=""

           IF '$DATA(XMY)

               SET XMY(.5)=""

 +6        DO ^XMD

           KILL XMY,^TMP("PSDMAPU",$JOB)

END        KILL %,%DT,%H,%I,DA,DIE,DR,JJ,MLN,NAOU,NN,OK,PSDA,PSDR,PSDRN,PSDT,PSDUZ,X,XMSUB,XMDUZ,XMTEXT,XMY,Y,^TMP("PSDAPU",$JOB)

 +1        KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"