| 1 | PSGFILD0 ;BIR/CML3-SON OF VARIOUS FILES' UPKEEP ; 15 May 98 / 9:25 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**3,63**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(59.7 is supported by DBIA 2181
|
|---|
| 5 | ;
|
|---|
| 6 | ENDTE ; default team edit
|
|---|
| 7 | I '$O(^PS(57.7,DA,1,0)) W !!,"NO TEAMS ENTERED TO CHOOSE FROM!" K X Q
|
|---|
| 8 | N DIC,DIE S DIC="^PS(57.7,"_DA_",1,",DIC(0)="EQM" D ^DIC I Y'>0 K X Q
|
|---|
| 9 | S X=+Y Q
|
|---|
| 10 | ;
|
|---|
| 11 | ENOAOPT ; order action on patient transfer
|
|---|
| 12 | D ENSWT I %<0 K % Q
|
|---|
| 13 | K DA,DR S DA=1,DIE="^PS(59.7,",DR="[PSJ OAOPT]" D ^DIE
|
|---|
| 14 | D ENCV^PSGSETU Q
|
|---|
| 15 | ;
|
|---|
| 16 | ENSWT ; set-up discontinue on all ward transfers
|
|---|
| 17 | F W !!,"Do you want the instructions for auto-discontinue set-up" S %=1 D YN^DICN Q:% D
|
|---|
| 18 | .W !!?2,"Enter ""YES"" to view the instructions for the auto-discontinue set-up. Enter",!,"""NO"" to bypass the instructions. Enter ""^"" to abort the set-up."
|
|---|
| 19 | Q:%<0 D:%=1 ENWAI^PSGFILD1
|
|---|
| 20 | F W !!,"Do you want the package to set-up all of your wards for auto-discontinue" S %=2 D YN^DICN Q:% D SWTH
|
|---|
| 21 | Q:%'=1 W !!?3,"Working..." K PSGW S PSGW=0 F Q=0:0 S Q=$O(^DIC(42,Q)) Q:'Q I $D(^(Q,0)) S X=$P(^(0),"^"),PSGW(Q)=$S(X]"":X,1:Q_";DIC(42,"),PSGW=PSGW+1
|
|---|
| 22 | I '$D(^PS(59.7,1,22,0)) S ^(0)="^59.722P"
|
|---|
| 23 | F PSGX=0:0 S PSGX=$O(PSGW(PSGX)) Q:'PSGX W !,PSGW(PSGX),"..." D:'$D(^PS(59.7,1,22,PSGX)) SW F PSGY=0:0 S PSGY=$O(PSGW(PSGY)) Q:'PSGY I PSGX'=PSGY,'$D(^PS(59.7,1,22,PSGX,1,PSGY,0)) D SW1
|
|---|
| 24 | K PSGW,PSGX,PSGY S %=0 Q
|
|---|
| 25 | ;
|
|---|
| 26 | SW ;
|
|---|
| 27 | W "." K DIC,DA,DD,DO S DIC="^PS(59.7,1,22,",DIC(0)="L",DA(1)=1,(DINUM,X)=PSGX D FILE^DICN S:'$D(^PS(59.7,1,22,PSGX,1,0)) ^(0)="^59.7221P" Q
|
|---|
| 28 | ;
|
|---|
| 29 | SW1 ;
|
|---|
| 30 | W "." K DIC,DA,DD,DO S DIC="^PS(59.7,1,22,"_PSGX_",1,",DIC(0)="L",DA(2)=1,DA(1)=PSGX,(DINUM,X)=PSGY D FILE^DICN Q
|
|---|
| 31 | ;
|
|---|
| 32 | SWTH ;
|
|---|
| 33 | W !?2,"Enter ""YES"" to have the package set-up all of your wards for auto-discontinue",!,"for you. Enter ""NO"" if you prefer to set-up the wards individually. Enter ""^""",!,"to abort the set-up."
|
|---|
| 34 | W !!?2,"If you answer YES, you will still be able to add, edit and delete individual",!,"wards.",!!?2,"PLEASE NOTE that this is not a flag for the package, but a one-time action.",!,"If you add new wards to your WARD LOCATION file, you will"
|
|---|
| 35 | W " need to add those",!,"wards here." Q
|
|---|
| 36 | ;
|
|---|
| 37 | ENSUEP ; supervisor edit of user parameters
|
|---|
| 38 | F K DIC S DIC="^PS(53.45,",DIC(0)="AELQZ",DIC("A")="Select INPATIENT USER: ",DLAYGO=53.45 W ! D ^DIC K DIC,LAYGO Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(53.45,",DR="[PSJ IUP SUPER EDIT]",IU=+Y(0) D W ! D ^DIE
|
|---|
| 39 | .F X=1:1:3 I $D(^XUSEC("PSJ "_$P("RPHARM^RNURSE^PHARM TECH","^",X),IU)) Q
|
|---|
| 40 | .S:'$T X=0 S R=$G(^VA(200,IU,"PS")),R=$S('R:0,'$P(R,"^",4):1,1:$P(R,"^",4)>DT)
|
|---|
| 41 | .W !!,"This user is a " W:X $P("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X) W:'X&'R "WARD CLERK" W:'R "." I R W:X " and a " W "PROVIDER."
|
|---|
| 42 | K IU,PSJ,R D ENKV^PSGSETU W !!,"PLEASE NOTE: Any changes made will not take effect for the corresponding users",!,"until those users completely exit and re-enter the system." Q
|
|---|
| 43 | ;
|
|---|
| 44 | ENUUEP ;
|
|---|
| 45 | D ENCV^PSGSETU K DA,DR S DA=PSJSYSP,DIE="^PS(53.45,",DR="[PSJ IUP USER EDIT]" D W ! D ^DIE K ^TMP("PSJUSER",$J,"PSG") D ENKV^PSGSETU
|
|---|
| 46 | .F X=1:1:3 I $D(^XUSEC("PSJ "_$P("RPHARM^RNURSE^PHARM TECH","^",X),DUZ)) Q
|
|---|
| 47 | .S:'$T X=0 S R=$G(^VA(200,DUZ,"PS")),R=$S('R:0,'$P(R,"^",4):1,1:$P(R,"^",4)>DT)
|
|---|
| 48 | .W !!,"You are a " W:X $P("PHARMACIST^NURSE^PHARMACY TECHNICIAN","^",X) W:'X&'R "WARD CLERK" W:'R "." I R W:X " and a " W "PROVIDER."
|
|---|
| 49 | W !!,"PLEASE NOTE: Any changes made take effect immediately." Q
|
|---|
| 50 | ;
|
|---|
| 51 | ENIWPE ; edit inpatient ward parameters
|
|---|
| 52 | F K DIC S DIC="^PS(59.6,",DIC(0)="AELMQ",DIC("A")="Select WARD: ",DLAYGO=59.6 W ! D ^DIC K DIC Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(59.6,",DR="[PSJ IWP EDIT]" W ! D ^DIE
|
|---|
| 53 | ;K ^TMP("OR",$J,"PSG")
|
|---|
| 54 | D ENKV^PSGSETU Q
|
|---|
| 55 | ENOSD ; one-time stop date check
|
|---|
| 56 | N PSJWD
|
|---|
| 57 | I +X'=X!(X>100)!(X<1)!(X?.E1"."1N.N) K X Q
|
|---|
| 58 | S PSJWD=$P(^PS(59.6,DA,0),"^",3)
|
|---|
| 59 | I PSJWD="",X>1 K X Q
|
|---|
| 60 | I X>PSJWD K X
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | ENPDE ; edit primary drug
|
|---|
| 64 | Q ; not used any more
|
|---|
| 65 | ;F K DIC S DIC="^PS(50.3,",DIC(0)="AELMQ",DIC("A")="Select PRIMARY DRUG: ",DLAYGO=50.3 W ! D ^DIC K DIC Q:Y'>0 K DA,DR S DA=+Y,DIE="^PS(50.3,",DR="[PSJ PD EDIT]" D ^DIE
|
|---|
| 66 | ;K DA,DIC,DIE,DLAYGO,DR,X,Y,PSGS0XT,PSGS0Y Q
|
|---|
| 67 | ;
|
|---|
| 68 | ENALU ; application look-up
|
|---|
| 69 | N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)=$E("E",'$D(PSJPRE4))_"IMZ" D DO^DIC1,^DIC I Y'>0 K X Q
|
|---|
| 70 | S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X Q
|
|---|
| 71 | ;
|
|---|
| 72 | ENAQ ; application query
|
|---|
| 73 | S X=DZ N DA,DIC,DIE,DO,DR,DZ S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC Q
|
|---|
