PSDIPOST.m

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

PSDIPOST  ;BIR/JPW,LTL-Post-Init ; 7 Feb 95

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**2**;13 Feb 97

 +2        SET XQABT4=$HOROLOG

CHECK     ;check for Controlled Subs V2.0

 +1        IF $$VERSION^XPDUTL("PSD")'<2

               SET PSD(1)="CONTROLLED SUBSTANCES VERSION 2.0 has been previously installed,"

               SET PSD(2)="no post-init conversion required."

               DO MES^XPDUTL(.PSD)

               KILL DIFQ,PSD

               GOTO QUIT^PSDIPOS1

DEA       ;marks ACTIVE drugs for CS use based on DEA special handling

 +1        SET PSD(1)="Using the DEA SPECIAL HANDLING data in your drug file I will now mark selected"

           SET PSD(2)="drugs for Controlled Substances use."

           SET PSD(3)="Marking now..."

           DO MES^XPDUTL(.PSD)

           KILL PSD

 +2        SET PSIUX="N"

           SET COUNT=0

 +3        FOR PSD=0:0

               SET PSD=$ORDER(^PSDRUG(PSD))

               IF 'PSD

                   QUIT 

               Begin DoDot:1

 +4                IF '$DATA(^PSDRUG(PSD,0))

                       QUIT 

                   SET OK=$SELECT('$DATA(^PSDRUG(PSD,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0)

                   IF 'OK

                       QUIT 

 +5                SET PSDN=$PIECE($GET(^PSDRUG(PSD,0)),"^",3)

                   SET OK=$SELECT(PSDN[1:1,PSDN[2:1,PSDN[3:1,PSDN[4:1,PSDN[5:1,PSDN["A":1,PSDN["C":1,1:0)

                   IF 'OK

                       QUIT 

 +6                IF '$DATA(^PSDRUG(PSD,2))

                       QUIT 

                   SET PSDN=$PIECE($GET(^PSDRUG(PSD,2)),"^",3)

                   SET OK=$SELECT(PSDN="":1,PSDN["O":1,PSDN["U":1,PSDN["I":1,1:0)

                   IF 'OK

                       QUIT 

 +7                SET PSIUDA=+PSD

                   SET COUNT=COUNT+1

 +8                SET X="PSSGIU"

                   SET PSDPSG=0

                   XECUTE ^%ZOSF("TEST")

                   IF $TEST

                       DO ENS^PSSGIU

                       SET PSDPSG=1

 +9                IF 'PSDPSG

                       DO ENS^PSGIU

 +10               KILL PSDPSG

               End DoDot:1

 +11       SET PSD="A total of "_COUNT_" drugs have been marked for CS package use."

 +12       DO MES^XPDUTL(PSD)

           KILL PSD

IND       ;re-index 'ac' & 'ad' in 58.86

 +1        DO MES^XPDUTL("...Cleaning up 'AIU' cross reference in the DRUG file (#50)...")

           SET X="AIU"

           FOR 

               SET X=$ORDER(^PSDRUG(X))

               IF X=""!($EXTRACT(X,1,3)'="AIU")

                   QUIT 

               KILL ^PSDRUG(X)

 +2        KILL X

 +3        DO MES^XPDUTL("Re-indexing 'AIU' cross reference...")

           SET DIK="^PSDRUG("

           SET DIK(1)="63^AIU"

           DO ENALL^DIK

           KILL DIK

 +4        DO MES^XPDUTL("Re-indexing the CS DESTRUCTION file...")

 +5        KILL DA,DIK

           SET DIK="^PSD(58.86,"

           SET DIK(1)=10

           DO ENALL^DIK

           KILL DIK,DA

 +6        SET PSD(1)="Re-indexing the DATE/TIME TURN IN DESTROY field in"

           SET PSD(2)="the DRUG ACCOUNTABILITY TRANSACTION file..."

           DO MES^XPDUTL(.PSD)

           KILL PSD

 +7        KILL DA,DIK

           SET DIK="^PSD(58.81,"

           SET DIK(1)="37"

           DO ENALL^DIK

           KILL DA,DIK

 +8        DO MES^XPDUTL("...the RECEIPT DATE/TIME...")

 +9        KILL DA,DIK

           SET DIK="^PSD(58.81,"

           SET DIK(1)="21"

           DO ENALL^DIK

           KILL DA,DIK

 +10       DO MES^XPDUTL("ok.")

 +11       KILL COUNT,DIC,DIK,DLAYGO,NODE,OK,PSD,PSD1,PSD2,PSDN,PSIUA,PSIUDA,PSIUX,X

 +12       GOTO ^PSDIPOS1