1 | PSGPLDP0 ;BIR/CML3-ENTER UNITS DISPENSED (PART 2) ;23 OCT 97 / 9:34 AM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
---|
3 | ;
|
---|
4 | S PSGPLTND=^PS(53.5,PSGPLG,0),WSF=$P(PSGPLTND,"^",7)
|
---|
5 | I $P(PSGPLTND,"^",2),'$P(PSGPLTND,"^",9) S PSGOD=$$ENDTC^PSGMI($P(PSGPLTND,"^",11)) W $C(7),$C(7),!!?33,"*** WARNING ***",!,"THIS PICK LIST STARTED TO RUN ",PSGOD,", BUT HAS NOT RUN TO COMPLETION."
|
---|
6 | ;
|
---|
7 | PRN ;
|
---|
8 | F W !!,"Do you want to see PRN meds only" S %=2 D YN^DICN Q:% D PRNM^PSGPLDPH
|
---|
9 | I %<0 S PRN="^" Q
|
---|
10 | S PSGLCNT=0,PRN=%-1,(PC,TM)="" W @IOF
|
---|
11 | ;
|
---|
12 | TM ;
|
---|
13 | S OK="" F S TM=$O(^PS(53.5,"AC",PSGPLG,TM)) Q:TM="" S WDN="" F S WDN=$O(^PS(53.5,"AC",PSGPLG,TM,WDN)) Q:WDN="" D:PRN&'WSF W1 S RB="" F S (PR,RB)=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB)) Q:RB="" S PN="" D PN G OUT:OK["^^^",TM:OK["^^"
|
---|
14 | ;
|
---|
15 | OUT ;
|
---|
16 | W:'PRN&'PC !!?2,"(No PRN meds founds.)" F W !!,"ARE YOU FINISHED WITH THIS PICK LIST" S %=1 D YN^DICN Q:% D FMSG^PSGPLDPH
|
---|
17 | Q:%<0 G:%'=1 PRN I $P(PSGPLTND,"^",3) D NOW^%DTC I $P(PSGPLTND,"^",3)>% Q
|
---|
18 | ;
|
---|
19 | FILE ;
|
---|
20 | F W !!,"MAY I FILE THE DATA IN THIS PICK LIST AWAY" S %=2 D YN^DICN Q:% D FIMSG^PSGPLDPH
|
---|
21 | I %=1 S DIE="^PS(53.5,",DA=PSGPLG,DR=".05////1" D ^DIE K DIE
|
---|
22 | Q
|
---|
23 | ;
|
---|
24 | PN ;
|
---|
25 | S OK="" F D Q:PN="" S PSGP=$P(PN,"^",2),WF=0 D:WSF&PRN W1 D:PRN W2 D ST Q:OK["^^" G:OK="^" PN
|
---|
26 | .I ($E(OK,1,1)'="^")&($P(OK,"^",2)'?1.AP) S PN=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN)),OK="" Q
|
---|
27 | .S DIC="^PS(53.5,"_PSGPLG_",1,",DIC(0)="EQZ",X=$P(OK,"^",2),OK="" D ^DIC K DIC I Y<0 S PN="" Q
|
---|
28 | .S Y=$S(WSF:"zns",1:$P(Y(0),"^",3))
|
---|
29 | .S RB=$P($G(^PS(53.5,PSGPLG,1,+Y(0),0)),U,4) I RB]"",$P(^PS(53.5,PSGPLG,0),U,6),RB'="zz" S RB=$S($P(RB,"-",2)?1N:0,1:"")_$P(RB,"-",2)_"-"_$P(RB,"-")
|
---|
30 | .S RB=$S($P(^PS(53.5,PSGPLG,0),"^",8)=1:"zz",RB="":"zz",1:RB)
|
---|
31 | .I '$D(^PS(53.5,"AC",PSGPLG,$P(Y(0),"^",2),Y,RB,$E($P($G(^DPT(+Y(0),0)),U),1,12)_U_+Y(0))) S PN="" K Y Q
|
---|
32 | .S PN=$E($P($G(^DPT(+Y(0),0)),U),1,12)_U_+Y(0),TM=$P(Y(0),"^",2),WDN=Y K Y
|
---|
33 | ;
|
---|
34 | NP Q
|
---|
35 | ;
|
---|
36 | ST ;
|
---|
37 | S ST="A" F S ST=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST)) Q:"Z"[ST D DRG Q:OK["^"
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | DRG ;
|
---|
41 | S DRG=""
|
---|
42 | F S DRG=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG)) Q:DRG="" S PSGORD=$P(DRG,"^",2),PSJJORD=+$G(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,0)),SCH=$P($G(^PS(55,PSGP,5,PSJJORD,2)),"^") I SCH["PRN"!(ST="P")!PRN D GD Q:OK["^"
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | GD ;
|
---|
46 | S DDRG="" F Q:OK["^" S DDRG=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG,DDRG)) Q:DDRG="" S DN=+$P(DDRG,"^",2),DN=$G(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,DN,0)),PDD=$P(DN,"^",3),PDN=$P(DN,"^",2) I DN'["DI" D
|
---|
47 | .I DN="" W !,$$ENPDN^PSGMI(+$G(^PS(55,PSGP,5,PSJJORD,.2))),?42,"NEEDED: OI",?55,"DISPENSED:" D SCREEN Q
|
---|
48 | .S DR=$P($G(^PS(55,PSGP,5,PSJJORD,1,+DN,0)),"^"),DR=$$ENDDN^PSGMI(DR)
|
---|
49 | .S LMT=PDN*2+1000 I 'PRN S:'PC PC=1 I 'WF S WF=1,OK="??" D W1
|
---|
50 | .I PDN="WS" W !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",PDN D SCREEN Q
|
---|
51 | .S PSGLCNT=0
|
---|
52 | .F W !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",$S(PDD="":"",1:PDD_"// ") R OK:DTIME W:'$T $C(7) S:'$T OK="^^^" Q:$S(OK=+OK:OK'>LMT,OK?1.3"^":1,($E(OK,1,1)="^")&($P(OK,"^",2)?1.AP):1,1:OK="") D:OK?1."?" GDMSG I OK'?1."?" W $C(7)," ??"
|
---|
53 | .Q:($E(OK,1,1)="^")&($P(OK,"^",2)?1.AP)
|
---|
54 | .I OK="" S OK=$S(PDD]"":PDD,PDN="NV":"",1:PDN) W " ",OK
|
---|
55 | .I OK=+OK,OK'=PDD S $P(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,$P(DDRG,"^",2),0),"^",3)=OK
|
---|
56 | Q
|
---|
57 | ;
|
---|
58 | GDMSG ;
|
---|
59 | W !!," Enter the number of units actually dispensed for this medication. If the",!,"units dispensed is the same as the units needed (or units dispensed, if shown),",!,"just press the RETURN key."
|
---|
60 | W " Enter an '^' to jump ahead to the next patient,",!,"'^^' to jump ahead to the next team, or '^^^' to exit this pick list.",! Q:OK'?2."?"
|
---|
61 | ;
|
---|
62 | W1 ;
|
---|
63 | S PW=$S('WSF:WDN,1:$P(^PS(53.5,PSGPLG,1,PSGP,0),"^",3)),PSGLCNT=PSGLCNT+.5
|
---|
64 | W !!,"TEAM: ",$S(TM'["zz":TM,1:"* N/F *"),?40,"WARD: ",$S(WDN'["zz":PW,1:"* N/F *") Q:OK'?2."?"
|
---|
65 | ;
|
---|
66 | W2 ;
|
---|
67 | S PSSN=$S($D(^DPT(PSGP,0)):$E($P(^(0),"^",9),6,9),1:"* N/F *"),PPN=$S('$D(^(0)):PN,$P(^(0),"^")]"":$P(^(0),"^"),1:PN),PR=$P(^PS(53.5,PSGPLG,1,PSGP,0),"^",4)
|
---|
68 | W !!,?5,$S($P(PSGPLTND,"^",8):"ROOM-BED: ",$P(PSGPLTND,"^",6):"BED-ROOM: ",1:"ROOM-BED: "),$S(PR'["zz":PR,1:"* N/F *"),?30,PPN," (",PSSN,")",!
|
---|
69 | I '$D(^PS(53.5,PSGPLG,1,PSGP,1)) W !,?20,"(NO ORDERS)",! D SCREEN
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | SCREEN ; display break
|
---|
73 | S PSGLCNT=PSGLCNT+1 Q:PSGLCNT<4 S PSGLCNT=0 W !
|
---|
74 | K DIR S DIR("A")="Press RETURN to continue",DIR("?")="Enter ^ to go to next patient, ^XXX to go to patient XXX, ^^ to go to next ward, ^^^ to go to next team.",DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X" D ^DIR K DIR S OK=X
|
---|
75 | Q
|
---|