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