| [613] | 1 | PSGWTR ;BHAM ISC/PTD,CML-Transfer Stock Entries from One AOU to Another ; 08 Dec 93 / 10:02 AM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | K LOC("TR") S CT=0,PSGWDUZ=DUZ W !!,"This option will copy the stock entries from one AOU into AOUs",!,"you select. Inactive or duplicate items will not be transferred."
|
|---|
| 4 | W !,"Choosing to copy stock items into multiple AOUs will allow you",!,"to choose up to 10 AOUs at one time."
|
|---|
| 5 | HOWMANY W !!?5,"Do you wish to copy stock items INTO:",!?5,"(1) ONE Area of Use, or",!?5,"(2) multiple Areas of Use",!!,"Select ""1"" or ""2"": " R CHS:DTIME
|
|---|
| 6 | G:'$T!("^"[CHS) END I CHS=1!(CHS=2) G WHAT
|
|---|
| 7 | W !!,"Answer ""1"" if transfer to only ONE AOU is desired,",!,"answer ""2"" if the same stock list is to be copied into more than one AOU." G HOWMANY
|
|---|
| 8 | ;
|
|---|
| 9 | WHAT W !!?5,"Do you wish to transfer:",!?5,"(1) Drug (item) name only, or",!?5,"(2) Drug name, stock level, and location, or",!?5,"(3) Drug name, stock level, location, and type.",!!,"Select ""1"", ""2"", or ""3"": " R TR:DTIME
|
|---|
| 10 | G:'$T!("^"[TR) END I TR=1!(TR=2)!(TR=3) G DICF
|
|---|
| 11 | W !!,"Answer ""1"" if transfer of ONLY drug name is desired,",!,"answer ""2"" if you wish to copy drug name, stock level, and location, or",!,"answer ""3"" if you wish to transfer drug name, stock level, location, and types." G WHAT
|
|---|
| 12 | ;
|
|---|
| 13 | DICF W ! S DIC="^PSI(58.1,",DIC(0)="QEAM",DIC("A")="Select AOU to transfer stock list FROM: " D ^DIC K DIC G:Y<0 END S AOUF=+Y W !
|
|---|
| 14 | ;
|
|---|
| 15 | DICT S DIC="^PSI(58.1,",DIC(0)="QEAM",DIC("A")="Select AOU to transfer stock list INTO: " D ^DIC K DIC G:(Y<0)&(CHS=1) END G:(Y<0)&(CHS=2) SURE S LOC("TR",+Y)="",CT=CT+1 G:CT>9 LIMIT G:CHS=2 DICT
|
|---|
| 16 | ;
|
|---|
| 17 | SURE I $D(LOC("TR",AOUF)) W *7,*7,!!?5,"NOT ALLOWED to transfer out of and into SAME Area of Use!" G END
|
|---|
| 18 | G:'$O(LOC("TR",0)) END W !!?5,"I will now COPY the ENTIRE stock list from",!?5,$P(^PSI(58.1,AOUF,0),"^")," into" F J=0:0 S J=$O(LOC("TR",J)) Q:'J W !?5,$P(^PSI(58.1,J,0),"^")
|
|---|
| 19 | W !!?5,"I will transfer ",$S(TR=2:"drug name, stock level, and location.",TR=3:"drug name, stock level, location, and types.",1:"drug name only.")
|
|---|
| 20 | R !!,"Are you SURE that is what you want to do? NO// ",X:DTIME
|
|---|
| 21 | G:'$T!("^Nn"[$E(X)) END I "YyNn"'[$E(X) W *7,!!,"Answer ""yes"" if you wish to transfer stock entries.",!,"Answer ""no"" or <return> if you do not.",!! G SURE
|
|---|
| 22 | ;
|
|---|
| 23 | QUE W !!,"This job will automatically be queued to run in the background.",!,"You will be notified by MailMan when the transfer is completed.",!
|
|---|
| 24 | S AOUT="" F J=0:0 S J=$O(LOC("TR",J)) Q:'J S AOUT=AOUT_J_","
|
|---|
| 25 | S ZTIO="",ZTDTH=$H,ZTRTN="^PSGWTR1",ZTDESC="Transfer AOU Stock" F G="AOUF","TR","PSGWDUZ","AOUT" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 26 | D ^%ZTLOAD,HOME^%ZIS W !,"TRANSFER FILE ENTRIES queued!"
|
|---|
| 27 | END K AOUF,CHS,J,TR,X,G,ZTIO,AOUT,CT,PSGWDUZ,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,LOC("TR"),ZTSK
|
|---|
| 28 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 29 | ;
|
|---|
| 30 | LIMIT W !!,"You may not transfer TO additional AOUs at this time.",!,"Enter the option again to transfer to more AOUs." G SURE
|
|---|
