source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGPLDP0.m@ 619

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1PSGPLDP0 ;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 ;
7PRN ;
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 ;
12TM ;
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 ;
15OUT ;
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 ;
19FILE ;
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 ;
24PN ;
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 ;
34NP Q
35 ;
36ST ;
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 ;
40DRG ;
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 ;
45GD ;
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 ;
58GDMSG ;
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 ;
62W1 ;
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 ;
66W2 ;
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 ;
72SCREEN ; 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
Note: See TracBrowser for help on using the repository browser.