| 1 | PSDMAPU ;BIR/JPW-Stock Missing CS Appl. Pkg. Use ; 22 Jun 93
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
|
|---|
| 4 | S PSDUZ=DUZ D NOW^%DTC S PSDT=X
|
|---|
| 5 | DEV ;sets queueing information
|
|---|
| 6 | 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
|
|---|
| 7 | START ;queued entry point to check for non-CS entries in file 50
|
|---|
| 8 | K ^TMP("PSDAPU",$J)
|
|---|
| 9 | 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
|
|---|
| 10 | .Q:$P($G(^PSD(58.8,PSDA,0)),"^",3)'=+PSDSITE
|
|---|
| 11 | .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
|
|---|
| 12 | ..S OK=$S($P($G(^PSDRUG(PSDR,2)),"^",3)["N":1,1:0) Q:OK
|
|---|
| 13 | ..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
|
|---|
| 14 | ...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)=""
|
|---|
| 15 | MSG ;send mailman message with completed info
|
|---|
| 16 | K XMY,^TMP("PSDMAPU",$J) S MLN=1
|
|---|
| 17 | 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 "
|
|---|
| 18 | 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
|
|---|
| 19 | .S MLN=MLN+1,^TMP("PSDMAPU",$J,MLN,0)=" "_JJ
|
|---|
| 20 | S XMSUB="CS PHARM NON-CS DRUG SUMMARY",XMDUZ="CONTROLLED SUBSTANCES PHARMACY",XMTEXT="^TMP(""PSDMAPU"",$J,",XMY(PSDUZ)="" S:'$D(XMY) XMY(.5)=""
|
|---|
| 21 | D ^XMD K XMY,^TMP("PSDMAPU",$J)
|
|---|
| 22 | 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)
|
|---|
| 23 | K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
