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="@"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDMAPU 2030 printed Nov 22, 2024@16:56:55 Page 2
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="@"
