source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDIPOST.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1PSDIPOST ;BIR/JPW,LTL-Post-Init ; 7 Feb 95
2 ;;3.0; CONTROLLED SUBSTANCES ;**2**;13 Feb 97
3 S XQABT4=$H
4CHECK ;check for Controlled Subs V2.0
5 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
6DEA ;marks ACTIVE drugs for CS use based on DEA special handling
7 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
8 S PSIUX="N",COUNT=0
9 F PSD=0:0 S PSD=$O(^PSDRUG(PSD)) Q:'PSD D
10 .Q:'$D(^PSDRUG(PSD,0)) S OK=$S('$D(^PSDRUG(PSD,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0) I 'OK Q
11 .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
12 .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
13 .S PSIUDA=+PSD,COUNT=COUNT+1
14 .S X="PSSGIU",PSDPSG=0 X ^%ZOSF("TEST") I $T D ENS^PSSGIU S PSDPSG=1
15 .I 'PSDPSG D ENS^PSGIU
16 .K PSDPSG
17 S PSD="A total of "_COUNT_" drugs have been marked for CS package use."
18 D MES^XPDUTL(PSD) K PSD
19IND ;re-index 'ac' & 'ad' in 58.86
20 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)
21 K X
22 D MES^XPDUTL("Re-indexing 'AIU' cross reference...") S DIK="^PSDRUG(",DIK(1)="63^AIU" D ENALL^DIK K DIK
23 D MES^XPDUTL("Re-indexing the CS DESTRUCTION file...")
24 K DA,DIK S DIK="^PSD(58.86,",DIK(1)=10 D ENALL^DIK K DIK,DA
25 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
26 K DA,DIK S DIK="^PSD(58.81,",DIK(1)="37" D ENALL^DIK K DA,DIK
27 D MES^XPDUTL("...the RECEIPT DATE/TIME...")
28 K DA,DIK S DIK="^PSD(58.81,",DIK(1)="21" D ENALL^DIK K DA,DIK
29 D MES^XPDUTL("ok.")
30 K COUNT,DIC,DIK,DLAYGO,NODE,OK,PSD,PSD1,PSD2,PSDN,PSIUA,PSIUDA,PSIUX,X
31 G ^PSDIPOS1
Note: See TracBrowser for help on using the repository browser.