source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVOPT2.m@ 623

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1PSIVOPT2 ;BIR/PR,MLM-OPTION DRIVER (CONT) ;02 Mar 99 / 9:27 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**23,29,58,110,127,133,135,157**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PSSLOCK is supported by DBIA #2789
6 ;
7D ; Discontinue order.
8 D NATURE^PSIVOREN I '$D(P("NAT")) W !,$C(7),"Order Unchanged." S COMQUIT=1 Q
9 ;* 8/2* D EN1^PSJHL2(DFN,"OD",+ON55_"V","ORDER DISCONTINUED"),D1
10 I '$$REQPROV^PSGOEC W !,$C(7),"Order Unchanged." S COMQUIT=1 Q
11 I 'PSJCOM D
12 .D D1
13 .S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55 D LOG^PSIVORAL S P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3)
14 I PSJCOM N COMFLG S COMFLG=0 D
15 .I ON55'["P" N COMFLG,O,OO S (COMFLG,O)=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" Q:COMFLG D
16 .. Q:OO=ON55 I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
17 I PSJCOM Q:COMFLG N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D
18 .I OO["V" S ON55=OO D D1 S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55 D LOG^PSIVORAL N PSJORD S P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3),PSJORD=ON55 D HL^PSIVORA Q
19 .I OO["U" N PSGORD,PSJORD,PSJNOO K DA D NOW^%DTC S PSGDT=%,T=$E("T",'PSJSYSU),PSGALR=20,PSGP=DFN,DA=+OO,DA(1)=PSGP,(PSGORD,PSJORD)=OO,PSJNOO=P("NAT") D
20 ..S CF=$S($P(PSJSYSP0,U,5):1,PSGORD["U":0,1:($P($G(^PS(53.1,+PSGORD,0)),U,25)=""&($P($G(^(4)),U,7)=DUZ))) D ASET^PSGOEC,AC^PSGOEC
21 Q
22D1 N %,DA,DIE,DIU,STP,NSTOP
23 S NSTOP=$$DATE^PSJUTL2(),STP=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3),NSTOP=+$S(STP>NSTOP:NSTOP,1:STP),P(17)="D"
24 K TMP
25 S TMP(55.01,""_+ON55_","_DFN_","_"",109)=NSTOP
26 S:'$P($G(^PS(55,DFN,"IV",+ON55,2)),U,7) TMP(55.01,""_+ON55_","_DFN_","_"",116)=STP
27 S TMP(55.01,""_+ON55_","_DFN_","_"",100)="D"
28 S TMP(55.01,""_+ON55_","_DFN_","_"",.03)=NSTOP
29 S PSIVACT=1
30 D FILE^DIE("","TMP")
31 K TMP
32 I $S($G(PSIVAC)="OD":0,$G(PSIVAC)'="AD":1,$G(PSGALO)<1060:0,1:$P($G(PSJSYSW0),U,15)) S X=$S($G(PSIVAC)="AD":1,1:2) D ENLBL^PSIVOPT(X,$S(X=1:+$G(PSGUOW),1:DUZ),DFN,3,+ON55,$E("AD",1,3-X))
33 D:'$D(PSJIVORF) ORPARM^PSIVOREN Q:'PSJIVORF ;* S ORIFN=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,21) Q:'ORIFN
34 Q
35 ;
36R ; Renew order.
37 ;I PSJCOM D RIV^PSJCOMR Q
38 I PSJCOM D ^PSJCOMR Q
39 I P(17)="D",P(12) N ERR D RI W:$G(ERR)=1 $C(7)," Order unchanged." I $G(ERR)<2 S COMQUIT=1 Q
40 NEW PSGORQF S PSIVRNFG=1 D ORDCHK^PSJLIFN K PSIVRNFG W !
41 I $G(PSGORQF) S COMQUIT=1 Q
42 ;
43R1 ;
44 I $$EXPIRED^PSGOER(DFN,ON55) D Q
45 .W !?3," THIS ORDER HAS BEEN INACTIVE FOR ONE OR MORE SCHEDULED ADMINISTRATIONS"
46 .W !?20," AND CANNOT BE RENEWED!"
47 N PSJRNWDT,PSJOSTOP,OREASON S PSJRNWDT=$$DATE2^PSJUTL2(PSGDT) S:$G(ON55) PSJOSTOP=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3) I '(PSJOSTOP>P(2)),$G(PSGDT) S PSJOSTOP=PSGDT
48 S (PSIVOK,EDIT)="25^1" S P2=P(2),P(2)=PSJRNWDT D EDIT^PSIVEDT S P(2)=P2 K P2 I X="^" Q
49 S P(11)=$$ENRNAT^PSGOU($P($G(^PS(55,DFN,"IV",+ON55,2)),U,10),+VAIN(4),P(9),P(11))
50 D OK G:X["N" R1 I X=U D RD Q
51 S PSIVCHG=2
52 S P(17)="A",OREASON=P("RES"),P("RES")="R",P("FRES")="" D:'$D(PSJIVORF) ORPARM^PSIVOREN I PSJIVORF D Q:'$D(P("NAT"))
53 .D NATURE^PSIVOREN I '$D(P("NAT")) D RD Q
54 .S ON=ON55
55 S P(16)="",PSJORIFN="",PSIVACT=1,P("21FLG")="",P("RES")=OREASON D SET55^PSIVORFB
56 D:$P(^PS(55,DFN,"IV",+ON55,0),U,17)="A" RUPDATE^PSIVOREN(DFN,ON55,P(2))
57 I PSJIVORF,$P(^PS(55,DFN,"IV",+ON55,0),U,17)'="A" S X=$$LS^PSSLOCK(DFN,+ON55_"V") D
58 .D EXPOE^PSGOER(DFN,ON55)
59 .S P("RES")="R",PSJREN=1
60 .D ENUDTX^PSJOREN(DFN,ON55,"NR"),EN1^PSJHL2(DFN,"SN",+ON55_"V","ORDER RENEWED"),UPDREN(DFN,ON55,PSJRNWDT,P(6),PSJOSTOP,P("NAT"))
61 S OD=P(2)
62 D VF1^PSJLIACT("","",1),UNL^PSSLOCK(DFN,+ON55_"V")
63 D ENLBL^PSIVOPT(2,DUZ,DFN,3,+ON55,"R")
64 I $G(PSJOSTOP),$G(ON55),$G(DFN) D STIX^PSIVOREN(PSJOSTOP,ON55,DFN)
65 Q
66 ;
67RD ; Delete for renew.
68 ;Q:'$G(PSJVFY)
69 ;D DEL55^PSIVORE2 S (ON55,P("OLDON"))=P("PON") D GT55^PSIVORFB
70 Q
71 ;
72OK ;Print example label, run order through checker, ask if it is ok.
73 S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) I ($G(P("PD"))="") D GTPD^PSIVORE2
74 D ^PSIVCHK I $D(DUOUT) S X="^",COMQUIT=1 Q
75 I ERR=1 S X="N",COMQUIT=1 Q
76 W ! D ^PSIVORLB K PSIVEXAM S Y=P(2) W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
77 ;PSJ*5*157 EFD FOR IV
78 D EFDIV^PSJUTL($G(ZZND))
79 I $G(PSIVCHG),($G(PSIVREA)'="R") W !,"*** This change will cause a new order to be created. ***"
80 S X="Is this O.K.: ^"_$S(ERR:"N",1:"Y")_"^^NO"_$S(ERR'=1:",YES",1:"") D ENQ^PSIV I X["?" S HELP="OK" D ^PSIVHLP G OK
81 Q
82 ;
83RI ; Reinstate Auto-DC'ed order.
84 N DA,DIE,DIR,DIU,DR,PSIVACT,PSIVALT,PSIVALCK,PSIVREA W !!,$C(7),"This order has been Auto-DC'ed."
85 S DIR(0)="Y",DIR("A")="Reinstate this order" D ^DIR K DIR I 'Y S ERR=1 Q
86 D NOW^%DTC I %>$P($G(^PS(55,DFN,"IV",+ON55,2)),U,7) D
87 .K DIR S ERR=1,DIR(0)="Y",DIR("A",1)="The original stop date of this order has past.",DIR("A")="Do you wish to renew this order" D ^DIR K DIR S ERR=$S(Y:2,1:1)
88 Q:$G(ERR) S X=$G(^VA(200,+P(6),"PS")) I $S('X:1,'$P(X,U,4):0,DT<$P(X,U,4):0,1:1) S ERR=1
89 I $G(ERR) W !!,$C(7),"This order's provider is no longer valid. Please enter a valid provider." S (EDIT,PSIVOK)=1 D EDIT^PSIVEDT I $G(DONE) W $C(7),"Order unchanged." S ERR=1 Q
90 N PSGALO S PSGALO=18530 D ENARI^PSIVOPT(DFN,ON,DUZ,PSGALO)
91 Q
92 ;
93UPDREN(DFN,ORD,RNWDT,PROV,OSTOPDT,PSJNOO) ;
94 Q:'DFN!'ORD!'RNWDT!'PROV!'OSTOPDT!(PSJNOO="")
95 K DR,DA,DIC,DIE,DD,DO N ND0,PSGOEORD
96 S DIC="^PS(55,"_DFN_",""IV"","_+ORD S ND0=$G(@(DIC_",0)")),PSGOEORD=$P(ND0,"^",21) I $G(ON)["P",$G(PSGOLDOE) S PSGOEORD=PSGOLDOE
97 S DIC=DIC_",14,",DIC(0)="L",DIC("P")="55.1138DA",ND14=$G(@(DIC_"0)")),DINUM=$P(ND14,"^",3)+1,DA(2)=DFN,DA(1)=+ORD D
98 .S DIC("DR")=".01////"_$G(RNWDT)_";1////"_$G(DUZ)_";2////"_$G(PROV)_";3////"_$G(OSTOPDT)_";4////"_+PSGOEORD,X=$G(RNWDT) D FILE^DICN
99 .Q
100 K DO,DINUM
Note: See TracBrowser for help on using the repository browser.