VistA-WorldVistAEHR/r/INPATIENT_MEDICATIONS-PSJ-P.../PSJBCMA2.m

54 lines
1.9 KiB
Mathematica

PSJBCMA2 ;BIR/MV-RETURN INPATIENT ACTIVITY LOG ;16 Mar 99 / 11:43 AM
;;5.0; INPATIENT MEDICATIONS ;**32,41,54,56,81**;16 DEC 97
;
;Reference to ^PS(55 is supported by DBIA 2191
;
EN(DFN,ON,PSJTMP) ;
NEW X,Y
S PSJINX=0
S PSJTMP=$S($G(PSJTMP)=1:"PSJ2",1:"PSJ")
I $G(ON)["U",$D(^PS(55,+$G(DFN),5,+ON)) D UD
I $G(ON)["V",$D(^PS(55,+$G(DFN),"IV",+ON)) D IV
I '$D(^TMP(PSJTMP,$J,0)) S ^(0)=-1
K PSJINX
Q
UD ;Get Activity Log for Unit Dose order.
F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,5,+ON,9,PSJAL)) Q:'PSJAL D
. S X=$G(^PS(55,DFN,5,+ON,9,PSJAL,0))
. S PSJ("DATE")=$P(X,U)
. S (PSJ("USER"),PSJ("UIEN"))=$P(X,U,2),PSJ("FIELD")=$P(X,U,4)
. S PSJ("OLD DATA")=$P(X,U,5)
. S PSJ("ACTION")=$P($G(^PS(53.3,+$P(X,U,3),0)),U)
. D TMP K PSJ
K PSJAL
Q
IV ;Get Activity Log for IV order.
F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL)) Q:'PSJAL D
. K PSJ,PSJDD
. S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,0))
. S PSJ("DATE")=$P(X,U,5)
. S PSJ("ACTION")=$P(X,U,2) Q:PSJ("ACTION")="F"
. S PSJ("USER")=$P(X,U,3)
. S PSJ("REASON")=$P(X,U,4)
. S PSJ("ACTION")=$$CODES^PSIVUTL(PSJ("ACTION"),55.04,.02)
. S PSJ("UIEN")=$P(X,U,6)
. I $O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,0))="" D TMP
. F PSJFC=0:0 S PSJFC=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC)) Q:'PSJFC D
.. S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC,0))
.. K PSJ("FIELD"),PSJ("OLD DATA")
.. S PSJ("FIELD")=$P(X,U)
.. S PSJ("OLD DATA")=$P(X,U,2)
.. D TMP
K PSJ,PSJAL,PSJFC
Q
TMP ;Setup ^TMP
S PSJINX=PSJINX+1
I +PSJ("USER") D NAME^PSJBCMA1(+PSJ("USER"),.X,"") S PSJ("USER")=X
S ^TMP(PSJTMP,$J,0)=DFN_U_+ON_U_ON_U_PSJINX
S ^TMP(PSJTMP,$J,PSJINX,1)=PSJ("DATE")_U_PSJ("USER")_U_$G(PSJ("FIELD"))_U_PSJ("ACTION")_U_$G(PSJ("UIEN"))
S:$G(PSJ("OLD DATA"))]"" ^TMP(PSJTMP,$J,PSJINX,2)=PSJ("OLD DATA")
S:$G(PSJ("REASON"))]"" ^TMP(PSJTMP,$J,PSJINX,3)=PSJ("REASON")
Q
GETFLD ;
N X D FIELD^DID(55.04,.02,"","POINTER","PSJDD") Q