| 1 | PSGFILED ;BIR/CML3-VARIOUS FILES' UPKEEP ;16 Mar 99 / 10:22 AM
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**20,50,63,119,110,111,112,154**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^PS(50.606 supported by DBIA# 2174.
 | 
|---|
| 5 |  ; Reference to ^PSDRUG supported by DBIA# 2192.
 | 
|---|
| 6 |  ; Reference to ^PS(59.7 is supported by DBIA# 2181.
 | 
|---|
| 7 |  ; Reference to ^PS(51 is supported by DBIA# 2176.
 | 
|---|
| 8 |  ; Reference to ^PS(51.2 is supported by DBIA# 2178.
 | 
|---|
| 9 |  ; Reference to ^PS(55 is supported by DBIA# 2191.
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 | DONE D ENKV^PSGSETU K D0,D1,D2,PSGRBS Q
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 | GED ; generic edit
 | 
|---|
| 14 |  S DA=+Y,DR=".01;1" W ! D ^DIE Q
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 | ENAT ; team file
 | 
|---|
| 17 |  F  S DIC="^PS(57.7,",DIC(0)="QEAMIL",DLAYGO=57.7,DIC("A")="Select WARD: " W ! D ^DIC K DIC,DLAYGO Q:Y'>0  S DA=+Y,DIE="^PS(57.7,",DR="[PSJUMATE]" D ^DIE
 | 
|---|
| 18 |  G DONE
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 | ENAS ; schedules file - no longer used
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | ENMR ; med route file
 | 
|---|
| 23 |  NEW MRNO,MR K DIE,DIC,DR,Y
 | 
|---|
| 24 |  F  S DIC="^PS(51.2,",DIC(0)="QEAMIL",DLAYGO=51.2 W ! D ^DIC K DIC,DLAYGO Q:+Y'>0  S MRNO=+Y,MR=$P(Y,U,2),DA=+Y,DIE="^PS(51.2,",DR=".01;1;3;4" D ^DIE D DF
 | 
|---|
| 25 |  G DONE
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | ENWG ; ward group file
 | 
|---|
| 28 |  F  S DIC="^PS(57.5,",DIC(0)="QEAMIL",DLAYGO=57.5 W ! D ^DIC K DA,DIC,DR Q:+Y'>0  S DA=+Y,DIE="^PS(57.5,",DR="[PSJU WG]" D ^DIE
 | 
|---|
| 29 |  G DONE
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 | ENMI ; medication instruction file
 | 
|---|
| 32 |  F  S DIC="^PS(51,",DIC(0)="QEAMIL",DLAYGO=51 W ! D ^DIC K DIC Q:+Y'>0  S DIE="^PS(51,",DA=+Y,DR=".01;1;30" D ^DIE
 | 
|---|
| 33 |  G DONE
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 | ENDRG ; standard drug fields
 | 
|---|
| 36 |  D NOW^%DTC S PSGDT=% F  S DIC="^PSDRUG(",DIC(0)="AEIMOQ",DIC("A")="Select DISPENSE DRUG: " W ! D ^DIC K DIC Q:+Y'>0  D DE
 | 
|---|
| 37 |  K PSIUA,PSIUDA,PSIUX G DONE
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | DE ;
 | 
|---|
| 40 |  I $D(^PSDRUG(+Y,"I")),^("I"),^("I")<PSGDT W $C(7),$C(7),!!?3,"*** WARNING, THIS DRUG IS INACTIVE. ***",!
 | 
|---|
| 41 |  W ! S DIE="^PSDRUG(",(DA,PSIUDA)=+Y,DR="[PSJ FILED]"
 | 
|---|
| 42 |  S PSIUX="U^UNIT DOSE PHARMACY^1" D ^PSGIU,^DIE:PSIUA'["^" K DA,DIE,DR Q
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | ENOSE ; order set enter/edit
 | 
|---|
| 45 |  K DIC F  S DLAYGO=53.2,DIC="^PS(53.2,",DIC(0)="QEAML",DIC("A")="Select ORDER SET: " W ! D ^DIC K DIC Q:Y'>0  S DA=+Y S DIE="^PS(53.2,",DR="[PSJUOSE]" D ^DIE K D0,D1,DA,DIE,DR,PSGNEDFD,PSGS0XT,PSGS0Y
 | 
|---|
| 46 |  G DONE
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 | RBCHK ; used to validate room-bed
 | 
|---|
| 49 |  ;No longer used.
 | 
|---|
| 50 |  ;F Z0=0:0 S Z0=$O(^PS(57.7,DA(2),1,Z0)) Q:'Z0  I Z0'=DA(1),$D(^(Z0,1,"B",X)) W !?19,X," is already under ",$S('$D(^PS(57.7,DA(2),1,Z0,0)):"another team ("_Z0_")!",$P(^(0),"^")]"":$P(^(0),"^")_"!",1:"another team ("_Z0_")!") Q
 | 
|---|
| 51 |  ;I 'Z0,$D(^DIC(42,DA(2),2,+$O(^DIC(42,DA(2),2,"B",$P(X,"-"),0)),1,"B",$P(X,"-",2))) K Z0 Q
 | 
|---|
| 52 |  ;K X,Z0 Q
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 | RBQ ; show room-beds for a ward
 | 
|---|
| 55 |  ;No longer used.
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 | RBNP W """^"" TO STOP: " R Z3:DTIME W:'$T $C(7) S:'$T Z3="^" W $C(13),"            ",$C(13) Q
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 | ENPPD ; edit pharmacy patient data
 | 
|---|
| 61 |  ; W !!?3,"...This option is still under development...",! Q
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | ENCPDD ; edit patient's default stop date (wall)
 | 
|---|
| 64 |  D ENCV^PSGSETU I $D(XQUIT) Q
 | 
|---|
| 65 |  F  D ENAO^PSGGAO Q:PSGP'>0  D
 | 
|---|
| 66 |  .S WDN=$P($G(^DPT(PSGP,.1)),"^") W:WDN="" !!?2,"The patient is not currently on a ward."
 | 
|---|
| 67 |  .I WDN]"" S WD=$O(^DIC(42,"B",WDN,0)),WD=$O(^PS(59.6,"B",+WD,0)) I $S('WD:1,1:'$P($G(^PS(59.6,WD,0)),"^",4)) S X="PLEASE NOTE: The 'SAME STOP DATE' parameter for the ward ("_WDN_") is not turned on.  Any date entered here will be ignored "
 | 
|---|
| 68 |  .I  S X=X_"until the parameter is turned on for this ward." W $C(7),!!?2 F Y=1:1:$L(X," ") S X(1)=$P(X," ",Y) W:$L(X(1))+$X>78 ! W X(1)," "
 | 
|---|
| 69 |  .S DA=PSGP,DR="62.01T",DIE="^PS(55," W !! D ^DIE
 | 
|---|
| 70 |  K WD,WDN G DONE
 | 
|---|
| 71 |  ;
 | 
|---|
| 72 | ENSYS ; edit system file
 | 
|---|
| 73 |  ;/S DIE="^PS(59.7,",DA=1,DR="21;26;26.3;26.4;26.2;20.412ALLOW THE CHANGE OF ORDER TYPES ON ORDERS FROM OERR;32"
 | 
|---|
| 74 |  S DIE="^PS(59.7,",DA=1,DR="21;26;26.3;26.4;26.2;26.5;26.6;26.7;34;27;27.1"
 | 
|---|
| 75 |  W ! D ^DIE K DIE,DA,DR Q
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | ENPLSP ; edit pick list site parameters
 | 
|---|
| 78 |  ;
 | 
|---|
| 79 | ENCS ; change current site & parameters
 | 
|---|
| 80 |  I $D(PSJSYSW0)#2 W !!,"Current site: ",$P(PSJSYSW0,"^")
 | 
|---|
| 81 |  S PSGCSF=1 D ^PSGSET,ENKV^PSGSETU W:$D(XQUIT) !!?5,"(The Inpatient site you are currently working under has not changed.)" K PSGCSF,PSGORSET,XQUIT Q
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 | DF ; Add/edit Med route, instruction... to the Dosage form file.
 | 
|---|
| 84 |  S DIR("A")="Would you like to update the Dosage Form file"
 | 
|---|
| 85 |  S DIR("?")="If your answer is Yes, you will be able to Add/edit the Med routes, Instructions, Verb, Noun and Preposition that associate with this Dosage form."
 | 
|---|
| 86 |  S DIR(0)="Y",DIR("B")="Y" D ^DIR Q:Y'=1
 | 
|---|
| 87 |  NEW Y,DFNO K DIE,DIC,DA,DR
 | 
|---|
| 88 |  F  S DIC="^PS(50.606,",DIC(0)="QEAMI" D ^DIC Q:+Y'>0  S DFNO=+Y D
 | 
|---|
| 89 |  . I $G(MR)]"",'$D(^PS(50.606,DFNO,"MR","B",MRNO)) S DIE="^PS(50.606,",DR="1///"_MR,DA=DFNO D ^DIE
 | 
|---|
| 90 |  . K DIE,DIC,DR,MR S DIE="^PS(50.606,",DR="1;3;4;5",DA=DFNO D ^DIE
 | 
|---|
| 91 |  ;. K DIE,DIC,DR,MR S DIE="^PS(50.606,",DR="1;2;3;4;5",DA=DFNO D ^DIE
 | 
|---|
| 92 |  Q
 | 
|---|
| 93 | ENCD ;edit Clinic Definitions file
 | 
|---|
| 94 |  F  K DIC S DIC="^PS(53.46,",DIC(0)="AELMQ",DIC("A")="Select CLINIC: ",DLAYGO=53.46 D ^DIC K DIC Q:Y<0  D
 | 
|---|
| 95 |  . S DIE="^PS(53.46,",DA=+Y,DR="1;2;3" D ^DIE K DIE,DA,DR Q
 | 
|---|
| 96 | ENCG ; ward group file0
 | 
|---|
| 97 |  F  S DIC="^PS(57.8,",DIC(0)="QEAMIL",DLAYGO=57.8 W ! D ^DIC K DA,DIC,DR Q:+Y'>0  S DA=+Y,DIE="^PS(57.8,",DR=".01;1" D ^DIE
 | 
|---|
| 98 |  G DONE
 | 
|---|
| 99 |  ;
 | 
|---|