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="@"