source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOEPO.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
RevLine 
[613]1PSGOEPO ;BIR/CML3-PRINT ORDERS ENTERED BY PROVIDER ;12 Mar 98 / 3:23 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,58**;16 DEC 97
3 ;
4 ; Reference to ^PS(51.2 is supported by DBIA 2178.
5 ; Reference to ^PS(55 is supported by DBIA 2191.
6 ;
7 K %ZIS,IO("Q"),ZTSAVE S IOP=$P(PSJSYSO,"^"),%ZIS=$S($P(PSJSYSO,"^",2)=IO:"",1:"NQ") D ^%ZIS K IOP I $P(PSJSYSO,"^",2)=IO(0) G ENQOP
8 S PSGTIR="ENQOP^PSGOEPO",PSGTID=$H,ZTDESC="PROVIDER ORDERS PRINT",ZTSAVE("PSGOEPOF")="",ZTSAVE("PSJSYSU")="" S:PSGOEPOF'="A" ZTSAVE("PSGOP")="" D ENTSK^PSGTI K ZTSK G DONE
9 ;
10ENQOP ;
11 S TITLE=$P($G(^VA(200,DUZ,0)),"^") S:TITLE="" TITLE="Provider's Signature" S $P(LN1,"-",81)="" D NOW^%DTC S PSGOEPOD=$$ENDTC2^PSGMI(%) U IO
12 I PSGOEPOF="A" F PSGOP=0:0 S PSGOP=$O(^PS(53.44,DUZ,1,PSGOP)) Q:'PSGOP I $O(^(PSGOP,1,0)) D PO
13 I PSGOEPOF="A" G LAST
14 ;
15PO ;
16 D ^PSGLPI,HEADER S MORE=1,OCNT=0,PSGOEPOA="",PSGLTD=$P($G(^PS(55,PSGOP,5.1)),"^",4) F X="PSGLAD","PSGLTD" S @X=$E($$ENDTC2^PSGMI(@X),1,10)
17 F PSGOE=0:0 S PSGOEPOA=$O(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA)) Q:PSGOEPOA="" F PSGOEPO=0:0 S PSGOEPO=$O(^PS(53.44,DUZ,1,PSGOP,1,"AA",PSGOEPOA,PSGOEPO)) Q:'PSGOEPO I $D(^PS(53.44,DUZ,1,PSGOP,1,PSGOEPO,0)) S PSGORD=^(0) D OPRT
18 S DA(1)=DUZ,DA=PSGOP,DIK="^PS(53.44,"_DA(1)_",1," D ^DIK Q:PSGOEPOF="A"
19 ;
20LAST ;
21 S MORE=0 D BTM W:$Y @IOF,@IOF D ^%ZISC
22 ;
23DONE ;
24 K AD,DA,DIK,DO,FD,LN1,MORE,MR,ND,ND1,ND2,ND6,OCNT,OD,PSGID,PSGOD,PSGOEPO,PSGOEPOD,PSGOEPOF,PSGORD,SD,ST Q
25 ;
26HEADER ;
27 W:$Y @IOF W !!?2,"NURSE: Remove one copy and send to Pharmacy.",!!!!!,LN1,!?1,"VA FORM 10-1158",?21,"PROVIDER'S MEDICATION ORDERS",?53,"Printed: ",PSGOEPOD,!,LN1
28 W !?3,"|Date/|",?33,"ORDERS",?58,"| | Nurse's",!,"No.|Time |Action",?19,"Check here if NO SUBSTITUTE allowed. ->",?58,"| | Signature",!,LN1
29 Q
30 ;
31OPRT ;
32 S OD=$P(PSGORD,"^",3),PSGORD=$P(PSGORD,"^"),ND=$S(PSGORD["N":"^PS(53.1,"_+PSGORD,1:"^PS(55,"_PSGOP_",5,"_+PSGORD),ND=$G(@(ND_",0)")),ND2=$G(^(2)),ND6=$G(^(6)),ND1=$G(^(.1))
33 S MR=$P(ND,"^",3),ST=$P(ND,"^",7),ND=$P(ND,"^",9),SD=$P(ND2,"^",2),FD=$P(ND2,"^",4),AD=$P(ND2,"^",5),ND2=$P(ND2,"^"),DO=$P(ND1,"^",2),ND1=$P(ND1,"^") S:ST="P" ST="PRN" F X="SD","FD","OD" S @X=$$ENDTC^PSGMI(@X)
34 S MR=$S('$D(^PS(51.2,+MR,0)):MR_";PS(51.2,",$P(^(0),"^",3)]"":$P(^(0),"^",3),$P(^(0),"^")]"":$P(^(0),"^"),1:MR_";PS(51.2"),ND1=$S(ND1'=+ND1:"*"_ND1,'$D(^PS(50.3,+ND1,0)):ND1,$P(^(0),"^")]"":$P(^(0),"^"),1:ND1_";PS(50.3,")
35 I ND6]"" S ND6=$$ENSET^PSGSICHK($P(ND6,"^"))
36 D:$Y+10>IOSL BTM,HEADER S OCNT=OCNT+1 W !,$J(OCNT,3),"|",$E(OD,1,5),"|",$S(PSGOEPOA="C":"DC ",PSGOEPOA="R":"RNW",PSGOEPOA="W":"NEW",1:"???"),"|",ND1,?58-$L(ST),ST,?58,"| |"
37 W !?3,"|",$P(OD," ",2),"| | Give: ",DO,$E(" ",DO]""),MR," ",ND2,?58,"| | ",$S(PSGOEPOA'="N":"",ND="A":"ORDER ACTIVE",ND["D":"ORDER DC'D",ND="E":"ORDER EXP'D",1:"")
38 I AD]"" W !?3,"| | |",?58-$L(AD),AD,"| |"
39 I ND6]"" W !?3,"| | |" F Q=1:1:$L(ND6," ") S QQ=$P(ND6," ",Q) W:$X+$L(QQ)>57 ?58,"| |",!?3,"| | |" W QQ," "
40 W:ND6]"" ?58,"| |" W !,LN1 Q
41 Q
42 ;
43BTM ;
44 I $Y+11'>IOSL F Q=$Y:1:IOSL-12 W !
45 W !?25,"_______________",?45,"______________________________",!?25,"Date AND Time",?45,TITLE,!! I MORE W ?36,"THIS PATIENT'S ORDERS CONTINUE ON NEXT PAGE"
46 W !,LN1,!?1,PSGLPN,?36,"Ward: ",PSGLWDN,!?7,"PID: ",PSGLSSN,?32,"Room-Bed: ",PSGLRB,?59,"Admitted: ",PSGLAD,!?7,"DOB: ",PSGLDOB," (",PSGLAGE,")",?37,"Sex: ",PSGLSEX I PSGLTD W ?56,"Last Transfer: ",PSGLTD
47 Q
Note: See TracBrowser for help on using the repository browser.