source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJCOM.m@ 1504

Last change on this file since 1504 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1PSJCOM ;BIR/CML3-FINISH COMPLEX UNIT DOSE ORDERS ENTERED THROUGH OE/RR ;02 Feb 2001 12:20 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**110,186**;16 DEC 97
3 ;
4 ; Reference to ^VALM1 is supported by DBIA 10116.
5 ; Reference to ^PS(55 is supported by DBIA 2191.
6 ; Reference to ^%DTC is supported by DBIA 10000.
7 ; Reference to ^%RCR is supported by DBIA 10022.
8 ; Reference to ^DIR is supported by DBIA 10026.
9 ; Reference to ^TIUEDIT is supported by DBIA 2410.
10 ;
11UPD ;
12 Q:'PSJCOM
13 M ^TMP("PSJCOM",$J,+PSGORD)=^PS(53.1,+PSGORD)
14 I PSGST="",(PSGSCH="NOW"!(PSGSCH="ONCE")) S PSGST="O"
15 S $P(^TMP("PSJCOM",$J,+PSGORD,0),"^",9)="N",$P(^(0),"^",4)="U",$P(^(0),"^",7)=PSGST,$P(^TMP("PSJCOM",$J,+PSGORD,2),"^",2)=PSGSD,$P(^(2),"^",4)=PSGFD
16 I $D(PSGSI),$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S ^TMP("PSJCOM",$J,+PSGORD,6)=PSGSI
17 I $D(PSGSI),$P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S $P(^TMP("PSJCOM",$J,+PSGORD,6),U)=$P(PSGSI,U) I $P(PSGSI,U)="" S $P(^TMP("PSJCOM",$J,+PSGORD,6),U,2)=""
18 S:$D(PSGSCH) $P(^TMP("PSJCOM",$J,+PSGORD,2),"^")=PSGSCH
19 I PSGSM,PSGOHSM'=PSGHSM S $P(^TMP("PSJCOM",$J,+PSGORD,0),"^",5)=PSGSM,$P(^TMP("PSJCOM",$J,+PSGORD,0),"^",6)=PSGHSM
20 W "."
21 S PSGOEEWF="^TMP(""PSJCOM"",$J,+PSGORD,"
22 F Q=1,3 K @(PSGOEEWF_Q_")") S %X="^PS(53.45,"_PSJSYSP_","_$S(Q=1:2,1:1)_",",%Y=PSGOEEWF_Q_"," K @(PSGOEEWF_Q_")") D %XY^%RCR W "." ;MOU-0100-30945
23 S PSGND=$G(^TMP("PSJCOM",$J,+PSGORD,0)),X=$P(PSGND,U,24)
24 S PSJOWALL=+$G(^PS(55,PSGP,5.1))
25 I $S(X="R":1,+$G(^PS(55,PSGP,5.1))>PSGDT:0,1:X'="E") S X=$G(^TMP("PSJCOM",$J,+PSGORD,2)) D ENWALL^PSGNE3(+$P(X,U,2),+$P(X,U,4),PSGP)
26 S $P(^TMP("PSJCOM",$J,+PSGORD,.2),U,2)=PSGDO,$P(^TMP("PSJCOM",$J,+PSGORD,2),U,5)=PSGAT S:$G(PSGS0XT) $P(^(2),U,6)=PSGS0XT
27 I 'PSGOEAV D NEWNVAL(PSGORD,$S(+PSJSYSU=3:22005,1:22000))
28 I PSGOEAV,+PSJSYSU=3 D VFY Q
29 I PSGOEAV,$G(PSJRNF) D VFY
30 Q
31VFY ; change status, move to 55, and change label record
32 Q:'PSJCOM
33 I '$D(^TMP("PSJCOM",$J,+PSGORD)) M ^TMP("PSJCOM",$J,+PSGORD)=^PS(53.1,+PSGORD)
34 NEW PSJDOSE,PSJDSFLG
35 D DOSECHK^PSJDOSE
36 I +$G(PSJDSFLG) D SETVAR^PSJDOSE W !!,PSJDOSE("WARN"),!,PSJDOSE("WARN1") I '$$CONT() W !,"...order was not verified..." D PAUSE^VALM1 D Q:'$G(PSJACEPT)
37 . S PSGOEEF(109)=1
38 . S PSJACEPT=0
39 D DDCHK G:CHK DONE
40 W !,"...a few moments, please..."
41 I PSGORD["P" D
42 . S PSGORDP=PSGORD ;Used in ACTLOG to update activity log in ^TMP
43 . I '$D(^TMP("PSJCOM2",$J,+PSGORD)) D Q
44 .. NEW PSGX S PSGX=$G(^TMP("PSJCOM",$J,+PSGORD,2.5)),PSGRSD=$P(PSGX,U),PSGRFD=$P(PSGX,U,3)
45 .. S $P(^TMP("PSJCOM",$J,+PSGORD,0),"^",9)="A" W "." ;D ^PSGOT
46 . NEW PSGX S PSGX=$G(^TMP("PSJCOM2",$J,+PSGORD,2.5)),PSGRSD=$P(PSGX,U),PSGRFD=$P(PSGX,U,3)
47 . S $P(^TMP("PSJCOM2",$J,+PSGORD,0),"^",9)="A" W "." ;D ^PSGOT
48 D NEWNVAL(+PSGORD,(PSJSYSU*10+22000)) W "."
49 S VND4=$S('$D(^TMP("PSJCOM2",$J,+PSGORD)):$G(^TMP("PSJCOM",$J,+PSGORD,4)),1:$G(^TMP("PSJCOM2",$J,+PSGORD,4)))
50 I $G(PSGRSD) D
51 . S PSGRSD=$$ENDTC^PSGMI(PSGRSD) D NEWNVAL(PSGORD,6090,"Requested Start Date",PSGRSD)
52 . S PSGRFD=$$ENDTC^PSGMI(PSGRFD) D NEWNVAL(PSGORD,6090,"Requested Stop Date",PSGRFD)
53 N DUR,DURORD S DURON=$S($G(ON)&($G(PSGORD)["U"):ON,$G(PSGORD):PSGORD,1:"") Q:'DURON D
54 . S DUR=$S($P($G(PSGRDTX),U,2)]"":$P($G(PSGRDTX),U,2),1:$$GETDUR^PSJLIVMD(PSGP,+DURON,$S($G(DURON)["P":"P",$G(DURON)["V":"IV",1:5),1),1:"")
55 I DUR]"" S $P(^TMP("PSJCOM2",$J,+PSGORD,2.5),"^",2)=DUR
56 ;D:$D(PSGORDP) ACTLOG(PSGORDP,PSGP,PSGORD)
57 K PSGRSD,PSGRFD,PSGALFN
58 NEW X S X=0 I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S X=1
59 I +PSJSYSU=3,PSGORD'["O",$S(X:0,'$P(VND4,"^",16):1,1:$P(VND4,"^",15)) ;D EN^PSGPEN(+PSGORD)
60 S:'$P(VND4,U,+PSJSYSU=3+9) $P(VND4,U,+PSJSYSU=3+9)=+$P(VND4,U,+PSJSYSU=3+9)
61 ;S $P(VND4,"^",+PSJSYSU=1+9)=1,$P(VND4,U,+PSJSYSU=3+9)=0
62 S:$P(VND4,"^",15)&'$P(VND4,"^",16) $P(VND4,"^",15)="" S:$P(VND4,"^",18)&'$P(VND4,"^",19) $P(VND4,"^",18)="" S:$P(VND4,"^",22)&'$P(VND4,"^",23) $P(VND4,"^",22)=""
63 S $P(VND4,"^",PSJSYSU,PSJSYSU+1)=DUZ_"^"_PSGDT
64 S:'$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM",$J,+PSGORD,4)=VND4 S:$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM2",$J,+PSGORD,4)=VND4
65 W:'$D(PSJSPEED) ! W !,"ORDER VERIFIED.",!
66 I '$D(PSJSPEED) K DIR S DIR(0)="E" D ^DIR K DIR
67 S VALMBCK="Q"
68 S ^TMP("PSJCOM",$J)="A" S:$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM2",$J)="A"
69 ;
70DONE ;
71 W:CHK !!,"...order NOT verified..."
72 I '$D(PSJSPEED),'CHK,+PSJSYSU=3,$G(PSJPRI)="D" D
73 .N DIR W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Do you want to enter a Progress Note",DIR("B")="No" D ^DIR
74 .Q:Y="N"
75 .D MAIN^TIUEDIT(3,.TIUDA,PSGP,"","","","",1)
76 S VALMBCK="Q" K CHK,DA,DIE,F,DP,DR,ND,PSGAL,PSGODA,PSJDOSE,PSJVAR,VND4,X Q
77 ;
78DDCHK ; dispense drug check
79 S DRGF=$S('$D(^TMP("PSJCOM2",$J,+PSGORD)):"^TMP(""PSJCOM"","_$J_","_+PSGORD_",",1:"^TMP(""PSJCOM2"","_$J_","_+PSGORD_","),CHK=$S('$O(@(DRGF_"1,0)")):7,1:0)
80 S PSGPD=$G(@(DRGF_".2)"))
81 S CHK=$S('$$DDOK^PSGOE2(DRGF_"1,",PSGPD):7,1:0)
82 Q:CHK=0
83 W $C(7),!!,"This order must have at least one valid, active dispense drug to be verified."
84 ;
85CONT() ;
86 NEW DIR,DIRUT,Y
87 W ! K DIR,DIRUT
88 S DIR(0)="Y",DIR("A")="Would you like to continue verifying the order",DIR("B")="Yes"
89 D ^DIR
90 Q Y
91 ;
92NEWNVAL(PSGALORD,PSGALC,PSGFLD,PSGOLD) ;
93 ;
94 ;Where PSGALORD = PSGORD (Required)
95 ; PSGALC = ACTIVITY CODE FROM #53.3 (Required)
96 ; PSGFLD = FIELD THAT CHANGED (Free text, optional)
97 ; PSGOLD = THE FIELDS OLD DATA VALUE (Free text, optional)
98 ;
99 ;N PSGALORD,PSGALC,PSGFLD,PSGOLD
100 ;
101 ; Create 0 node activity log for order if none exists, and get next entry number
102 I '$D(^TMP("PSJCOM2",$J,+PSGALORD)) D Q
103 . S QQ=$G(^TMP("PSJCOM",$J,+PSGALORD,"A",0)) S:QQ="" QQ="^53.1119D" F Q=$P(QQ,"^",3)+1:1 I '$D(^(Q)) S $P(QQ,"^",3,4)=Q_"^"_Q,^(0)=QQ,PSGAL("N")=Q Q
104 . ;Set up data to be held in activity log record
105 . D NOW^%DTC S PSGDT=+$E(%,1,12)
106 . I $L($G(PSGOLD))>170 S PSGOLD=$E(PSGOLD,1,167)_"..." ; Use of ... indicates old data field was greater than 170 characters
107 . S Q=%_"^"_$S(PSGALC=6010:"AUTO CANCEL",$D(DUZ)[0:"UNKNOWN",DUZ]"":DUZ,1:"UNKNOWN")_"^"_PSGALC_"^"_$S($D(PSGFLD):PSGFLD,1:"")_"^"_$S($D(PSGOLD):PSGOLD,1:"")
108 . ; Create activity log entry
109 . S ^TMP("PSJCOM",$J,+PSGALORD,"A",PSGAL("N"),0)=Q
110 S QQ=$G(^TMP("PSJCOM2",$J,+PSGALORD,"A",0)) S:QQ="" QQ="^53.1119D" F Q=$P(QQ,"^",3)+1:1 I '$D(^(Q)) S $P(QQ,"^",3,4)=Q_"^"_Q,^(0)=QQ,PSGAL("N")=Q Q
111 ;Set up data to be held in activity log record
112 D NOW^%DTC S PSGDT=+$E(%,1,12)
113 I $L($G(PSGOLD))>170 S PSGOLD=$E(PSGOLD,1,167)_"..." ; Use of ... indicates old data field was greater than 170 characters
114 S Q=%_"^"_$S(PSGALC=6010:"AUTO CANCEL",$D(DUZ)[0:"UNKNOWN",DUZ]"":DUZ,1:"UNKNOWN")_"^"_PSGALC_"^"_$S($D(PSGFLD):PSGFLD,1:"")_"^"_$S($D(PSGOLD):PSGOLD,1:"")
115 ; Create activity log entry
116 S ^TMP("PSJCOM2",$J,+PSGALORD,"A",PSGAL("N"),0)=Q
117 Q
Note: See TracBrowser for help on using the repository browser.