source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVORFE.m@ 846

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PSIVORFE ;BIR/MLM-IV FLUID ORDER ENTRY FOR OE/RR FRONT DOOR. ;26 NOV 97 / 9:55 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**58,81,110**;16 DEC 97
3 ;
4 ; Reference to ^VA(200 is supported by DBIA 10060.
5 ;
6EN ; Entry pt. to create new IV Fluid order.
7 S PSJORNP=$G(ORNP) D PS^PSIVOREN Q:PSJORPF F D NEWORD Q:DONE
8 D DONE^PSIVORA1
9 Q
10 ;
11NEWORD ; Create new IV Fluid order.
12 D SETUP S EDIT=58,PSIVOK="" D EDIT^PSIVEDT I '$D(DRG("SOL")) S DONE=1 Q
13 ; Removed reference to tag 66 of PSIVEDT-backdoor Pharm Prov comments
14 S EDIT="57^59",PSIVOK=58 D EDIT^PSIVEDT Q:DONE
15 K DA,DIC,ON,P("OLDON") W !!,"...transcribing this order..." D ENGNN^PSGOETO S ON=DA D PUT531^PSIVORFA L -^PS(53.1,+ON) W !
16 Q
17 ;
18GTFLDS ;Ask field no.s to be edited.
19 N PSGEFN F X=1:1:$L(EDIT,U) S PSGEFN(X)=$P(EDIT,U,X)_U_$S($P(EDIT,U,X)=999:"Edit OE/RR Fields",1:$$CODES2^PSIVUTL(53.1,$P(EDIT,U,X)))
20 S Y=$P($G(XQORNOD(0)),"=",2)
21 S PSGEFN=1_":"_$L(EDIT,U),PSJDTYP=$E(PSIVAC,1) D:Y="" ENEFA^PSGON K PSJDTYP I '$G(Y) S:PSIVAC="OE" DONE=1 S PSJEDFLG=1 Q
22 S X=EDIT,EDIT="" F X1=1:1:$L(Y,",") S:$P(X,U,$P(Y,",",X1)) $P(EDIT,"^",X1)=$P(X,U,$P(Y,",",X1))
23 N PSIVRENW S PSIVRENW=1
24 D EDIT^PSIVEDT
25 K PSIVRENW
26 Q
27 ;
28SET ; Set variables needed to create/update orders in the ORDERS file (100).
29 Q
30 ;*** NO LONGER NEEDED IN 5.0
31 N DRGT,PLN,X K OREVENT,ORETURN,ORSTRT,ORSTOP,ORTX
32 S ORL=$$ENORL^PSJUTL($G(VAIN(4)))
33 S ORLOG=P("LOG"),ORSTRT=P(2),OREVENT=$S('P(3):"",1:P(3)_";E"),ORSTOP=P(3),ORNP=+P(6),P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")
34 D GTOT^PSIVUTL(P(4)) ;* S ORPCL=$P(P("OT"),U,2)
35 ;* S Y=P(17),ORSTS=$S("AO"[Y:6,Y="E":7,Y="H":3,Y="D":1,Y="U":11,1:5),ORVP=DFN_";DPT(",ORPK=+ON_$S(ORSTS=5:"P",ORSTS=11:"P",1:"V")
36SORTX ;Set up ORTX(.
37 Q
38 ;*** NO LONGER NEEDED IN 5.0
39 I $E(P("OT"))="H" D
40 .S ORTX(1)="* TPN * in ",PLN=2 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X S ORTX(PLN)=$S($P($G(DRG("SOL",X)),U,2)]"":$P(DRG("SOL",X),U,2),1:"*NF*"),PLN=PLN+1
41 .S ORTX(PLN)=$S(P(8)]"":P(8),1:P(9)),PLN=PLN+1
42 I $E(P("OT"))="F" D ORTXF
43 I $E(P("OT"))="I" S ORTX(1)=$P(P("PD"),U,2),ORTX(2)="Give: "_$P(P("MR"),U,2)_" "_$S(P(9)]"":P(9),1:P(8)),PLN=3
44 S ORTX(1)=$S($G(P("FRES"))="R":"RENEWED -",$G(P("RES"))="R":"RENEWAL -",1:"")_ORTX(1)
45 ;I $D(^PS(53.45,+$G(PSIVUP),4)) F PC=0:0 S PC=$O(^PS(53.45,PSIVUP,4,PC)) Q:'PC S ORTX(PLN)=$G(^PS(53.45,PSIVUP,4,PC,0)),PLN=PLN+1
46 Q
47 ;
48ORTXF ; Set up ORTX( for Fluids.
49 Q
50 ;*** NO LONGER NEEDED IN 5.0
51 N SOLF
52 S PLN=1 F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI D
53 .S ORTX(PLN)=$S($P(DRG(DRGT,DRGI),U,2)="":"*NF*",1:$P(DRG(DRGT,DRGI),U,2)_" "_$P(DRG(DRGT,DRGI),U,3)),PLN=PLN+1 I DRGT="SOL",('$G(SOLF)) S ORTX(PLN-1)="in "_ORTX(PLN-1),SOLF=1
54 S ORTX(PLN)=$S(P(8)]"":P(8),1:P(9)),PLN=PLN+1
55 Q
56 ;
57SETUP ; Initialize variables.
58 K DRG D NEWENT S DRGN="" F X=2,3,5,7,8,9,11,15,23,"AD","DO","IVRM","MR","NEWON","PC","PD","OLDON","OPI","REM","REN","SI","SOL","SYRS" S P(X)=""
59 S PSJORSTS=11,P("OT")="F^",P("RES")="N",P(4)="A",P(17)="U",Y=$G(^VA(200,+PSJORNP,0)),P(6)=+PSJORNP_U_$P(Y,U)
60 ;; S PSJORSTS=11,P("OT")="F^"_$O(^ORD(101,"B","PSJI OR PAT FLUID OE",0))_";ORD(101,",P("RES")="N",P(4)="A",P(17)="U",Y=$G(^VA(200,+PSJORNP,0)),P(6)=+PSJORNP_U_$P(Y,U)
61 Q
62 ;
63NEWENT ; Get login date/entry code for new order
64 S P("LOG")=$$DATE^PSJUTL2(),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U)
65 Q
Note: See TracBrowser for help on using the repository browser.