Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJAC

PSJAC.m

Go to the documentation of this file.
  1. PSJAC ;BIR/CML3 - INPATIENT INFORMATION ;28 Apr 98 / 9:02 AM
  1. ;;5.0;INPATIENT MEDICATIONS;**8,10,50,127,181,275,279,331**;16 DEC 97;Build 15
  1. ;
  1. ; Reference to ^PS(55 is supported by DBIA# 2191.
  1. ;
  1. S DFN=PSGP,PSJACPF=1 G CHK
  1. ;
  1. ENBOTH ;
  1. S PSJACPF=11 G CHK
  1. ;
  1. ENIV ;
  1. N I,J,JJ,ON,PSJRBXX,X,X1,X2,X,Y S PSJACPF=10,PSGP=DFN
  1. ;
  1. CHK ;
  1. ;Check if 5.0 order conversion should be run for the selected patient.
  1. ;I '$P($G(^PS(55,DFN,5.1)),U,11) D CONVERT^PSJUTL1(DFN,$S($E(IOST,1)="C":1,1:0))
  1. ;/Commented out in PSJ*5*50. No longer needed
  1. ;/F S PSJRBXX=$$OTF^OR3CONV(DFN,$S($E(IOST,1)="C":0,1:1)) Q:+PSJRBXX'<0 D
  1. ;/.I +PSJRBXX=-1 W:$E(IOST,1)="C" !,$P(PSJRBXX,"^",2) H 4
  1. ;Converting IV order to new OI with POE if not done so when installed PSJ*5*50
  1. D CNIV^PSJUTL1(DFN)
  1. ;I $D(^PS(55,DFN,0)),'$P($G(^PS(55,DFN,0)),U,6) D EN^PSOHLUP(DFN)
  1. S VA200=1 D INP^VADPT
  1. I VAIN(4) S:PSJACPF#2 PSJPCAF=1_"^"_VAIN(1),PSJPWD=+VAIN(4),PSJPWDN=$P(VAIN(4),"^",2),PSJPTS=+VAIN(3),PSJPTSP=+VAIN(2),PSJPRB=VAIN(5),PSJPAD=+VAIN(7),PSJPDX=VAIN(9),PSJPTD=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",4),1:""),PSJPDD="" G CNV
  1. S VAIP("D")="L" D IN5^VADPT G:PSJACPF[0 CNV
  1. S PSJPCAF="",PSJPAD=+VAIP(13,1)
  1. S PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38)!($G(VADM(6))),PSJPWD=+VAIP(5),PSJPWDN=$P(VAIP(5),"^",2),PSJPRB=$P(VAIP(6),"^",2),PSJPTSP=+VAIP(7),PSJPTS=+VAIP(8),PSJPDX=VAIP(9),PSJPTD="",PSJPDD=PSGID_"^"_$$ENDTC^PSGMI(PSGID) S:X PSJPDD=PSJPDD_"^1"
  1. ;
  1. CNV ;
  1. D DEM^VADPT,HTWT(PSGP)
  1. I PSJACPF#2 S PSGP(0)=VADM(1),PSJPSSN=VADM(2),PSJPDOB=+VADM(3),PSJPAGE=VADM(4),PSJPSEX=$S(VADM(5)]"":VADM(5),1:"?^____"),PSJPPID=VA("PID"),PSJPBID=VA("BID")
  1. I PSJACPF#2 D
  1. .I $D(PSJY2K) D Q
  1. ..F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC2^PSGMI(+@X)
  1. .F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC^PSGMI(+@X)
  1. ;
  1. WP ; ward parameters
  1. G:$D(PSJACNWP) DONE S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD) S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
  1. S PSJSYSL="",X=$P(PSJSYSU,";",3)>1 S PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16)) G:$D(PSJACND) DONE
  1. I PSJSYSL D
  1. .S:X X='$P($G(PSJSYSP0),"^",10) S IOP=$S($P($G(PSJSYSP0),"^",13)]"":$P($G(PSJSYSP0),"^",13),$P(PSJSYSW0,"^",19+X)]"":$P(PSJSYSW0,"^",19+X),1:"") I IOP]"" D
  1. ..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
  1. ;
  1. D CLINIC
  1. ;
  1. DONE ;
  1. I PSJACPF<10 K VADM,VAIN,VAIP
  1. K PSJACPF,PSGID,PSGOD,VA200,X
  1. Q
  1. HTWT(DFN) ; Get patient's height and weight from Vitals.
  1. S (PSJPWTD,PSJPHTD)=""
  1. S X="GMRVUTL" X ^%ZOSF("TEST") I S GMRVSTR="HT" D
  1. . D EN6^GMRVUTL S PSJPHT=$P(X,U,8) S:PSJPHT PSJPHT=$J(2.54*PSJPHT,0,2),PSJPHTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
  1. . S GMRVSTR="WT" D EN6^GMRVUTL S PSJPWT=$P(X,U,8) S:PSJPWT PSJPWT=$J(PSJPWT/2.20462262,0,2),PSJPWTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
  1. F X="PSJPWT","PSJPHT" S:'$G(@X) @X="______"
  1. F X="PSJPWTD","PSJPHTD" S:$G(@X)="" @X="(________)"
  1. Q
  1. PSJAC2(PSJY2K) ;
  1. D PSJAC Q
  1. Q
  1. ACTCLIN(PSGP,PSGORD) ; Don't allow active clinic orders to be copied. If Pending order, allow CLINIC^PSJOE to reject based on order status.
  1. N CLIN,CLNODE S CLIN=0
  1. I $G(PSGORD)["P"!($G(PSGORD)=+$G(PSGORD)) S CLIN=0
  1. I $G(PSGORD)["U" S CLNODE=$G(^PS(55,PSGP,5,+PSGORD,8)) I CLNODE&($P(CLNODE,"^",2)) S CLIN=1
  1. I $G(PSGORD)["V" S CLNODE=$G(^PS(55,PSGP,"IV",+PSGORD,"DSS")) I CLNODE&($P(CLNODE,"^",2)) S CLIN=1
  1. I $G(CLIN) W !!,"You cannot copy this CLINIC Order." D PAUSE^VALM1 Q 1
  1. Q 0
  1. ;
  1. CLINIC ; clinic parameters
  1. N CL,CLIEN,CLNAM S CL=0 F S CL=$O(^PS(53.46,CL)) Q:'CL S CLIEN=$G(^(CL,0)) I CLIEN S PSJSYSW0("CLINIC",+CLIEN,0)=CLIEN I $D(^PS(53.46,CL,1)) S PSJSYSW0("CLINIC",+CLIEN,1)=^(1)
  1. Q