PSDTRA.m

PSDTRA ;BIR/JPW-Transfer Stock Entries from AOU to NAOU ; 18 July 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)

 K LOC("TR") S CNT=0,PSDUZ=DUZ

 W !!,"This option will copy the stock entries from one AR/WS AOU into NAOUs you ",!,"select.  No more than 10 transfers are allowed at a time.",!,"Inactive drugs will not be transferred.",!

NUM ;ask how many NAOUs

 W ! K DA,DIR,DIRUT S DIR(0)="SO^1:Transfer to one NAOU;2:Transfer to multiple NAOUs",DIR("A")="Select Transfer Type"

 S DIR("?",1)="Answer '1' if transfer to only ONE NAOU is desired, '2' if the same",DIR("?")="stock list is to be copied into more than one NAOU, or '^' to quit."

 D ^DIR K DIR G:$D(DIRUT) END S ANS=+Y

METHOD ;asks method of stock transfer

 W !!!,"=>  Methods of transferring stock drug data."

 W ! K DA,DIR,DIRUT S DIR(0)="SO^1:Drug name only;2:Drug name, stock level, and location code;3:Drug name, stock level, location code, and inv. types",DIR("A")="Select Transfer Method"

 S DIR("?",1)="Answer '1' if transfer of ONLY drug name is desired, '2' if you wish to",DIR("?",2)="copy drug name, stock level, and location code, '3' if you wish to transfer"

 S DIR("?")="drug name, stock level, location code, and inv. type, or '^' to quit."

 D ^DIR K DIR G:$D(DIRUT) END S MTR=+Y

FROM ;select AR/WS AOU to transfer stock from

 W ! K DA,DIC S DIC=58.1,DIC(0)="QEA",DIC("A")="Select AR/WS AOU to transfer drug stock FROM: " D ^DIC K DIC G:Y<0 END S AOU=+Y

TO ;select NAOU(s) to transfer stock to

 W ! K DA,DIC S DIC=58.8,DIC(0)="QEA",DIC("A")="Select NAOU to transfer drug stock INTO: ",DIC("S")="I $P(^(0),""^"",2)'=""P"",$P(^(0),""^"",3)=+PSDSITE"

 D ^DIC K DIC G:(Y<0)&(ANS=1) END G:(Y<0)&(ANS=2) CHK S LOC("TR",+Y)="",CNT=CNT+1

 I CNT>9 W !!,"You may not transfer TO additional NAOUs at this time.",!,"Enter the option again to transfer to more NAOUs.",!

 I ANS=2,CNT<10 G TO

CHK ;checks for valid NAOUs

 G:'$O(LOC("TR",0)) END

 W !!,?5,"I will now COPY the ENTIRE drug stock list from ",!,?5,$P(^PSI(58.1,AOU,0),"^"),"  into" F TR=0:0 S TR=$O(LOC("TR",TR)) Q:'TR  W !,?5,$P(^PSD(58.8,TR,0),"^")

 W !!,?5,"I will transfer ",$S(MTR=3:"drug name, stock level, location code and types.",MTR=2:"drug name, stock level and location code.",1:"drug name only.")

 W !! K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure that is what you want to do"

 S DIR("?",1)="Answer 'YES' if you wish to transfer stock entries,",DIR("?")="answer 'NO' or <RET> if you do not."

 D ^DIR K DIR I 'Y!$D(DIRUT) G END

QUE W !!,"This job will automatically be queued to run in the background.",!,"You'll be notified by a MailMan message when the transfer is completed.",!

 S NAOUT="" F TR=0:0 S TR=$O(LOC("TR",TR)) Q:'TR  S NAOUT=NAOUT_TR_","

 S ZTIO="",ZTDTH=$H,ZTRTN="^PSDTRA1",ZTDESC="Transfer AR/WS Stock to NAOU" S (ZTSAVE("MTR"),ZTSAVE("NAOUT"),ZTSAVE("AOU"),ZTSAVE("PSDUZ"))=""

 D ^%ZTLOAD W !!,"Transfer AR/WS Stock Drugs to NAOU has been queued.",!

END K ANS,AOU,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LOC,MTR,NAOUT,PSDUZ,TR,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 S:$D(ZTQUEUED) ZTREQ="@"

PSDTRA    ;BIR/JPW-Transfer Stock Entries from AOU to NAOU ; 18 July 94

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

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   QUIT 

 +3        KILL LOC("TR")

           SET CNT=0

           SET PSDUZ=DUZ

 +4        WRITE !!,"This option will copy the stock entries from one AR/WS AOU into NAOUs you ",!,"select.  No more than 10 transfers are allowed at a time.",!,"Inactive drugs will not be transferred.",!

NUM       ;ask how many NAOUs

 +1        WRITE !

           KILL DA,DIR,DIRUT

           SET DIR(0)="SO^1:Transfer to one NAOU;2:Transfer to multiple NAOUs"

           SET DIR("A")="Select Transfer Type"

 +2        SET DIR("?",1)="Answer '1' if transfer to only ONE NAOU is desired, '2' if the same"

           SET DIR("?")="stock list is to be copied into more than one NAOU, or '^' to quit."

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           SET ANS=+Y

METHOD    ;asks method of stock transfer

 +1        WRITE !!!,"=>  Methods of transferring stock drug data."

 +2        WRITE !

           KILL DA,DIR,DIRUT

           SET DIR(0)="SO^1:Drug name only;2:Drug name, stock level, and location code;3:Drug name, stock level, location code, and inv. types"

           SET DIR("A")="Select Transfer Method"

 +3        SET DIR("?",1)="Answer '1' if transfer of ONLY drug name is desired, '2' if you wish to"

           SET DIR("?",2)="copy drug name, stock level, and location code, '3' if you wish to transfer"

 +4        SET DIR("?")="drug name, stock level, location code, and inv. type, or '^' to quit."

 +5        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           SET MTR=+Y

FROM      ;select AR/WS AOU to transfer stock from

 +1        WRITE !

           KILL DA,DIC

           SET DIC=58.1

           SET DIC(0)="QEA"

           SET DIC("A")="Select AR/WS AOU to transfer drug stock FROM: "

           DO ^DIC

           KILL DIC

           IF Y<0

               GOTO END

           SET AOU=+Y

TO        ;select NAOU(s) to transfer stock to

 +1        WRITE !

           KILL DA,DIC

           SET DIC=58.8

           SET DIC(0)="QEA"

           SET DIC("A")="Select NAOU to transfer drug stock INTO: "

           SET DIC("S")="I $P(^(0),""^"",2)'=""P"",$P(^(0),""^"",3)=+PSDSITE"

 +2        DO ^DIC

           KILL DIC

           IF (Y<0)&(ANS=1)

               GOTO END

           IF (Y<0)&(ANS=2)

               GOTO CHK

           SET LOC("TR",+Y)=""

           SET CNT=CNT+1

 +3        IF CNT>9

               WRITE !!,"You may not transfer TO additional NAOUs at this time.",!,"Enter the option again to transfer to more NAOUs.",!

 +4        IF ANS=2

               IF CNT<10

                   GOTO TO

CHK       ;checks for valid NAOUs

 +1        IF '$ORDER(LOC("TR",0))

               GOTO END

 +2        WRITE !!,?5,"I will now COPY the ENTIRE drug stock list from ",!,?5,$PIECE(^PSI(58.1,AOU,0),"^"),"  into"

           FOR TR=0:0

               SET TR=$ORDER(LOC("TR",TR))

               IF 'TR

                   QUIT 

               WRITE !,?5,$PIECE(^PSD(58.8,TR,0),"^")

 +3        WRITE !!,?5,"I will transfer ",$SELECT(MTR=3:"drug name, stock level, location code and types.",MTR=2:"drug name, stock level and location code.",1:"drug name only.")

 +4        WRITE !!

           KILL DA,DIR,DIRUT

           SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("A")="Are you sure that is what you want to do"

 +5        SET DIR("?",1)="Answer 'YES' if you wish to transfer stock entries,"

           SET DIR("?")="answer 'NO' or <RET> if you do not."

 +6        DO ^DIR

           KILL DIR

           IF 'Y!$DATA(DIRUT)

               GOTO END

QUE        WRITE !!,"This job will automatically be queued to run in the background.",!,"You'll be notified by a MailMan message when the transfer is completed.",!

 +1        SET NAOUT=""

           FOR TR=0:0

               SET TR=$ORDER(LOC("TR",TR))

               IF 'TR

                   QUIT 

               SET NAOUT=NAOUT_TR_","

 +2        SET ZTIO=""

           SET ZTDTH=$HOROLOG

           SET ZTRTN="^PSDTRA1"

           SET ZTDESC="Transfer AR/WS Stock to NAOU"

           SET (ZTSAVE("MTR"),ZTSAVE("NAOUT"),ZTSAVE("AOU"),ZTSAVE("PSDUZ"))=""

 +3        DO ^%ZTLOAD

           WRITE !!,"Transfer AR/WS Stock Drugs to NAOU has been queued.",!

END        KILL ANS,AOU,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LOC,MTR,NAOUT,PSDUZ,TR,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"