source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGFILD3.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1PSGFILD3 ;BIR/CML3-RETURN OF VARIOUS FILES' UPKEEP ;12 DEC 97 / 10:53 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4ENRBLU ;
5 S Y=DA(2) N DA,DIC,DIE,DIX,DO,DR
6 S DIC="^DG(405.4,",DIC(0)="EIMZ",DIC("S")="I $D(^(""W"",""B"","_Y_"))" D DO^DIC1,^DIC I Y'>0 K X Q
7 I $D(^PS(57.7,"AWRT",D0,X)) D EN^DDIOL("THIS ROOM-BED ALREADY ASSIGNED TO TEAM FOR THIS WARD!") K X Q
8 S X=Y(0,0) Q
9 ;
10ENRBQ ;
11 S X=DZ,Y=DA(1) N D,DA,DIC,DIE,DO,DR,DZ,XQH
12 S DIC="^DG(405.4,",DIC(0)="EIMQ",DIC("S")="I $D(^(""W"",""B"","_Y_"))" D DO^DIC1,^DIC Q
13 ;
14ENATC ;
15 K DIR S DIR(0)="SAO^O:ONE ATC;M:MULTIPLE ATCS",DIR("A",1)="Do you want to set up your drugs for",DIR("A")="(O)ne ATC or (M)ultiple ATCs? ",DIR("B")="ONE ATC",DIR("?")="^D ATCH^PSGFILD3" D ^DIR
16 S ATC=$S($D(DIROUT):1,$D(DIRUT):1,$D(DTOUT):1,$D(DTOUT):1,Y="":1,1:Y) I ATC="O" K PSGW S PSGW=0 F Q=0:0 S Q=$O(^PS(57.5,Q)) Q:'Q I $D(^(Q,0)),$P(^(0),"^",2)="P" S PSGW=PSGW+1,PSGW(Q)=""
17 I 'ATC,$S(ATC="O":'PSGW,1:'$D(^PS(57.5,"AP"))) W $C(7),!!?3,"NOTE: No PHARMACY ward groups are found. You will not be able to enter",!?9,"canister numbers for selected drugs.",!
18 I 'ATC F FQ=0:0 W ! S DIC="^PSDRUG(",DIC(0)="QEAM",DIC("S")="I $D(^(2)),$P(^(2),""^"",3)[""U""" D ^DIC K DIC Q:Y'>0 D ATCED
19 K ATC,ATCN,DA,DIC,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,DLAYGO,DR,FQ,PSGW,X,Y Q
20 ;
21ATCED ;
22 K DA,DR S DIE="^PSDRUG(",DA=+Y,DR=212.2 I ATC="M",$D(^PS(57.5,"AP")) S DR=DR_";212",DR(2,50.0212)="1"
23 D ^DIE Q:$S($D(Y):1,ATC="M":1,1:'PSGW) K DIR S DIR(0)="50.0212,1" D ^DIR Q:'Y S ATCN=+Y,DA(1)=DA W !,"...working..." S:'$D(^PSDRUG(DA,212,0)) ^(0)="^50.0212P" F FQ=0:0 S FQ=$O(PSGW(FQ)) Q:'FQ D ATCCNS
24 Q
25 ;
26ATCCNS ;
27 W "." S DA=$O(^PSDRUG(DA(1),212,"B",FQ,0)) I DA,$D(^PSDRUG(DA(1),212,DA,0)) Q:$P(^(0),"^",2)=ATCN S DIE="^PSDRUG("_DA(1)_",212,",DR="1////"_ATCN D ^DIE Q
28 K DD,DO S DIC="^PSDRUG("_DA(1)_",212,",DIC(0)="L",DIC("DR")="1////"_ATCN,DLAYGO=50.0212,X=FQ D FILE^DICN Q
29 ;
30ATCH ;
31 W !!?2,"Enter 'M' to set up your drugs for use with multiple ATC Dispensing machines,",!,"for which you will have to enter a canister number for each ward group. Enter",!,"'O' to set up your drugs for use with one ATC Dispensing machine"
32 W ", for which",!,"the ward groups will be automatically set up for each canister number.",!,"CHOOSE FROM:",!?5,"O - ONE ATC",!?5,"M - MULTIPLE ATCS" Q
33 ;
34ENIU ; mark/unmark drugs for Unit Dose use
35 K DIR S DIR(0)="SAO^M:MARK FOR UNIT DOSE;U:UNMARK FOR UNIT DOSE",DIR("A")="Do you want to (M)ARK or (U)NMARK items for Unit Dose? ",DIR("B")="UNMARK",DIR("?")="^D ENIUH^PSGFILD3"
36 W ! D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT I Y'="U",Y'="M" K X,Y Q
37 S PSGY=Y,PSGS="I $P($G(^(2)),""^"",3)"_$E("'",PSGY="M")_"[""U""",PSIUX="U" K DIC
38 F S DIC="^PSDRUG(",DIC(0)="QEAM",DIC("A")="Select DRUG: ",DIC("S")=PSGS W ! D ^DIC K DIC Q:Y'>0 S PSIUDA=+Y D:PSGY="U" END^PSGIU D:PSGY="M" ENS^PSGIU W "..." W:PSGY="U" "UN" W "MARKED..."
39 K FQ,PSIUDA,PSIUX,PSGS,PSGY Q
40 ;
41ENIUH ;
42 W !!?2,"Enter 'M' to mark items for use by the Unit Dose Medications package. (You",!,"will only be shown items that have not been marked for Unit Dose.)",!?2,"Enter 'U' to unmark items that have previously been marked for use with Unit"
43 W !,"Dose. (You will be shown only items that have already been marked for Unit",!,"Dose.)",!!,"Choose from:",!?3,"M MARK ITEMS FOR UNIT DOSE",!?3,"U UNMARK ITEMS FOR UNIT DOSE" Q
Note: See TracBrowser for help on using the repository browser.