32 lines
2.0 KiB
Mathematica
32 lines
2.0 KiB
Mathematica
PSDIPOST ;BIR/JPW,LTL-Post-Init ; 7 Feb 95
|
|
;;3.0; CONTROLLED SUBSTANCES ;**2**;13 Feb 97
|
|
S XQABT4=$H
|
|
CHECK ;check for Controlled Subs V2.0
|
|
I $$VERSION^XPDUTL("PSD")'<2 S PSD(1)="CONTROLLED SUBSTANCES VERSION 2.0 has been previously installed,",PSD(2)="no post-init conversion required." D MES^XPDUTL(.PSD) K DIFQ,PSD G QUIT^PSDIPOS1
|
|
DEA ;marks ACTIVE drugs for CS use based on DEA special handling
|
|
S PSD(1)="Using the DEA SPECIAL HANDLING data in your drug file I will now mark selected",PSD(2)="drugs for Controlled Substances use.",PSD(3)="Marking now..." D MES^XPDUTL(.PSD) K PSD
|
|
S PSIUX="N",COUNT=0
|
|
F PSD=0:0 S PSD=$O(^PSDRUG(PSD)) Q:'PSD D
|
|
.Q:'$D(^PSDRUG(PSD,0)) S OK=$S('$D(^PSDRUG(PSD,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0) I 'OK Q
|
|
.S PSDN=$P($G(^PSDRUG(PSD,0)),"^",3),OK=$S(PSDN[1:1,PSDN[2:1,PSDN[3:1,PSDN[4:1,PSDN[5:1,PSDN["A":1,PSDN["C":1,1:0) Q:'OK
|
|
.Q:'$D(^PSDRUG(PSD,2)) S PSDN=$P($G(^PSDRUG(PSD,2)),"^",3),OK=$S(PSDN="":1,PSDN["O":1,PSDN["U":1,PSDN["I":1,1:0) Q:'OK
|
|
.S PSIUDA=+PSD,COUNT=COUNT+1
|
|
.S X="PSSGIU",PSDPSG=0 X ^%ZOSF("TEST") I $T D ENS^PSSGIU S PSDPSG=1
|
|
.I 'PSDPSG D ENS^PSGIU
|
|
.K PSDPSG
|
|
S PSD="A total of "_COUNT_" drugs have been marked for CS package use."
|
|
D MES^XPDUTL(PSD) K PSD
|
|
IND ;re-index 'ac' & 'ad' in 58.86
|
|
D MES^XPDUTL("...Cleaning up 'AIU' cross reference in the DRUG file (#50)...") S X="AIU" F S X=$O(^PSDRUG(X)) Q:X=""!($E(X,1,3)'="AIU") K ^PSDRUG(X)
|
|
K X
|
|
D MES^XPDUTL("Re-indexing 'AIU' cross reference...") S DIK="^PSDRUG(",DIK(1)="63^AIU" D ENALL^DIK K DIK
|
|
D MES^XPDUTL("Re-indexing the CS DESTRUCTION file...")
|
|
K DA,DIK S DIK="^PSD(58.86,",DIK(1)=10 D ENALL^DIK K DIK,DA
|
|
S PSD(1)="Re-indexing the DATE/TIME TURN IN DESTROY field in",PSD(2)="the DRUG ACCOUNTABILITY TRANSACTION file..." D MES^XPDUTL(.PSD) K PSD
|
|
K DA,DIK S DIK="^PSD(58.81,",DIK(1)="37" D ENALL^DIK K DA,DIK
|
|
D MES^XPDUTL("...the RECEIPT DATE/TIME...")
|
|
K DA,DIK S DIK="^PSD(58.81,",DIK(1)="21" D ENALL^DIK K DA,DIK
|
|
D MES^XPDUTL("ok.")
|
|
K COUNT,DIC,DIK,DLAYGO,NODE,OK,PSD,PSD1,PSD2,PSDN,PSIUA,PSIUDA,PSIUX,X
|
|
G ^PSDIPOS1
|