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

PSJOEA.m

Go to the documentation of this file.
  1. PSJOEA ;BIR/MLM-INPATIENT ORDER ENTRY ;12 June 2019 09:31:53
  1. ;;5.0;INPATIENT MEDICATIONS;**110,127,133,167,171,254,315,367,327**;16 DEC 97;Build 114
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ; Reference to ^PS(55 via DBIA #2191
  1. ; Reference to EN^VALM via DBIA #10118
  1. ; Reference to ^PSSLOCK via DBIA #2789
  1. ; Reference to ^DPT via DBIA #10035
  1. ; Reference to SDIMO^SDAMA203 via DBIA #4133
  1. ;
  1. LOCK(DFN,PSJORD) ; Check if the order is locked
  1. N Q S Q=0
  1. I PSJORD=+PSJORD N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",PSJORD,PSJO)) Q:'PSJO S Q=$$LS^PSSLOCK(DFN,PSJO_"P") I 'Q Q
  1. I Q Q 1
  1. Q 0
  1. ;
  1. SELECT ;
  1. N PSJCLIN,O
  1. Q:PSJORD=""!($G(Y)<0) Q:('$$LOCK^PSJOEA(PSGP,PSJORD))
  1. N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",PSJORD,PSJO)) Q:'PSJO D
  1. .S PSGORD="" S ON=PSJO_"P"
  1. .D DISACTIO(PSGP,PSJO_"P",$G(PSJPNV)) S:$G(PSJO)["V" O=ON
  1. K PSGCOMP,PSGFLG ; CLEAN UP VARIABLE FOR COMPLEX ORDER MESSAGE RJS*327
  1. I $D(^TMP("PSJCOM",$J)) D CHK^PSJOEA1
  1. S:'$G(PSGP) PSGP=$G(DFN)
  1. N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",PSJORD,PSJO)) Q:'PSJO D
  1. .L -^PS(53.1,PSJO) ; p367
  1. .D UNL^PSSLOCK(PSGP,PSJO_"P") ; Q:$G(Y)<0 p367 commented quit out
  1. ; p367 Unlock complex orders (file 100) after verification of all child orders in the complex order.
  1. N PSJO S PSJO=0 F S PSJO=$O(^TMP("PSJCVFY",$J,PSJO)) Q:'PSJO D
  1. .N PSJIDX S PSJIDX=$G(^TMP("PSJCVFY",$J,PSJO))
  1. .D UNL^PSSLOCK(PSGP,PSJIDX) K ^TMP("PSJCVFY",$J,PSJO),PSJIDX
  1. D DONE
  1. Q
  1. ;
  1. DISACTIO(DFN,PSJORD,PSJPNV) ; Display UD order and allow actions.
  1. ; DFN - Patient IEN
  1. ; PSJORD - Order #_location Code (P:53.1,V:55.01,U:55.06)
  1. ; PSJPNV - Invoked from Pending/NV option; (gets different hidden menu)
  1. N PSGP,PSJIVFLG,PSGSDX,PSGFDX,PSJXX1,ON55,PSJAPPT
  1. Q:PSJORD'["P"
  1. Q:$G(PSJCLIN)=-2
  1. S PSGP=DFN D ENIV^PSJAC
  1. D GETUD^PSJLMGUD(DFN,PSJORD)
  1. S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
  1. S:$G(PSJTUD) PSGPD=$G(PSJCOI),PSGPDN=$$OINAME^PSJLMUTL(+PSGPD)
  1. K PSGOENG I '$D(PSGPRF) D Q:$G(PSGOENG)
  1. . I PSJORD["P" L +^PS(53.1,+PSJORD):1 E S PSGOENG=1
  1. . I $G(PSGOENG) W !,"This order is being edited by another terminal.",! S PSGOENG=1 K DIR S DIR(0)="E" D ^DIR K DIR Q
  1. S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD)
  1. I PSJORD["P" S PSJXX1=$G(^PS(53.1,+PSJORD,0)) I PSGP'=$P(PSJXX1,U,15)!(DFN'=$P(PSJXX1,U,15)) Q ;L -^PS(53.1,+PSJORD) Q
  1. I PSJORD["P" D S PSJXX1=$P($G(^PS(53.1,+PSJORD,0)),U,9) I $S($G(PSJIVFLG):1,$G(Y)<0:1,"PADE"[PSJXX1:1,1:0) Q ;L -^PS(53.1,+PSJORD) Q
  1. .I $P(PSJXX1,U,9)="N",($P(PSJXX1,U,4)'="U") D Q
  1. .. S P("PON")=PSJORD,PSIVFLG=1
  1. .. D GT531^PSIVORFA(+PSGP,PSJORD),VF^PSIVORC2
  1. .I $P(PSJXX1,U,9)="P" D Q
  1. ..S:$G(PSJTUD) $P(PSJXX1,U,4)="U"
  1. ..N VAIP S PSJCLIN=$G(^PS(53.1,+PSJORD,"DSS")),PSJAPPT=$P(PSJCLIN,"^",2),PSJCLIN=$P(PSJCLIN,"^")
  1. ..I $P(PSJXX1,U,4)="U",(+PSJPDD) D Q:(PSJCLIN=-2)
  1. ...I $$PATCH^XPDUTL("SD*5.3*285"),($$SDIMO^SDAMA203(PSJCLIN,DFN)>-1) Q
  1. ...W !!,"Cannot process an Out-patient Unit Dose order for ",$P($G(^DPT(+PSGP,0)),U) D PAUSE^VALM1 S PSJIVFLG=1,PSJCLIN=-2
  1. ..NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
  1. ..D REQDT^PSJLIVMD(PSJORD)
  1. ..I $P(PSJXX1,U,4)="U",($G(PSGSCH)="") W !!,"Invalid schedule, can't finish this order" D PAUSE^VALM1 Q
  1. ..I $P(PSJXX1,U,4)="U" N PSJLM S PSJLM=1,PSGORD=PSJORD D START^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),@$S($G(PSJTUD):"FINISH^PSGOEF",1:"EN^VALM(""PSJ LM PENDING EDIT"")") D Q
  1. ...K ^TMP("PSJINTER",$J),PSJOVR
  1. ..I $P(PSJXX1,U,4)'="U",PSGP=$P(PSJXX1,U,15),DFN=$P(PSJXX1,U,15) S PSJLYN=PSJORD D EN^PSJLIFN S PSJIVFLG=1 K PSJLYN,PSJMAI
  1. I $G(PSIVFLG) K PSIVFLG Q
  1. S PSGACT=$$ENACTION^PSGOE1(PSGP,PSJORD),PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSJORD),ENSFE^PSGOEE0(PSGP,PSJORD),EN^VALM("PSJ LM UD ACTION")
  1. ;Send SN to CPRS if autoverify OFF and Order Set Entry and no 21st piece
  1. I $D(PSGOES),'PSGOEAV,$D(PSGORD),PSGORD["P",$P($G(^PS(53.1,+PSGORD,0)),"^",21)']"" D ORSET^PSGOETO1
  1. Q
  1. ;
  1. ACTLOG(PSGORDP,DFN,PSGORD) ;Store 53.1 activity log in local array to be moved to 55
  1. ;PSGORDP: IEN from 53.1
  1. ;PSGORD : IEN from 55
  1. NEW PSGX,PSGXDA,PSGAL531,Q,QQ
  1. F PSGX=0:0 S PSGX=$O(^PS(53.1,+PSGORDP,"A",PSGX)) Q:'PSGX D
  1. . S PSGAL531=$G(^PS(53.1,+PSGORDP,"A",PSGX,0))
  1. . S QQ=$G(^PS(55,DFN,5,+PSGORD,9,0)) S:QQ="" QQ="^55.09D" F Q=$P(QQ,U,3)+1:1 I '$D(^(Q)) S $P(QQ,U,3,4)=Q_U_Q,^(0)=QQ,PSGXDA=Q Q
  1. . S ^PS(55,DFN,5,+PSGORD,9,PSGXDA,0)=PSGAL531
  1. Q
  1. ;
  1. UD ;
  1. N DA,DR,DIE,PSJCMPDA D ENGNA^PSGOETO S $P(^TMP("PSJCOM",$J,PSJO,0),"^",26)=DA_"U",$P(^TMP("PSJCOM2",$J,PSJO,0),"^")=DA,$P(^(0),"^",18)=DA S PSJCMPDA=DA
  1. M ^PS(55,PSGP,5,DA)=^TMP("PSJCOM2",$J,+PSJO) M ^PS(53.1,+PSJO)=^TMP("PSJCOM",$J,+PSJO) D EN1^PSJHL2(PSGP,"OD",+PSJO_"P") S PSJNOO=$P(^TMP("PSJCOM2",$J,+PSJO,.2),U,3) D EN1^PSJHL2(PSGP,"SN",+PSJCMPDA_"U")
  1. N PSGPDRG,PSGST,PSGNESD,PSGNEFD,ND2,ND2P1
  1. S PSGPDRG=$P($G(^PS(55,PSGP,5,PSJCMPDA,.2)),"^"),PSGST=$P($G(^PS(55,PSGP,5,PSJCMPDA,0)),"^",7)
  1. S ND2=$G(^PS(55,PSGP,5,PSJCMPDA,2)),PSGNESD=$P(ND2,"^",2),PSGNEFD=$P(ND2,"^",4) D CRA^PSGOETO
  1. S ND2P1=$G(^PS(55,PSGP,5,PSJCMPDA,2)),PSGRMVT=$P(ND2P1,"^",2) ;*315
  1. K ^PS(53.1,"ACX",PSJORD,PSJO) K PSJPREX
  1. I $G(PSJCMPDA) D CMPLX2^PSJCOM1(PSGP,PSJORD,+PSJCMPDA_"U") I $G(PSGPXN) S PSJPREX=1
  1. Q
  1. IV ;
  1. K ON55 I $P($G(^PS(53.1,+PSJO,0)),"^",24)="R",$P($G(^PS(53.1,+PSJO,0)),"^",25) S ON55=$P(^PS(53.1,+PSJO,0),"^",25)
  1. I '$G(ON55) D NEW55^PSIVORFB
  1. S $P(^TMP("PSJCOM",$J,PSJO,0),"^",26)=ON55,$P(^TMP("PSJCOM2",$J,PSJO,0),"^")=+ON55
  1. S $P(^TMP("PSJCOM2",$J,PSJO,2),U,5)=PSJO_"P",$P(^TMP("PSJCOM",$J,PSJO,0),U,26)=ON55
  1. M ^PS(55,DFN,"IV",+ON55)=^TMP("PSJCOM2",$J,+PSJO) M ^PS(53.1,+PSJO)=^TMP("PSJCOM",$J,+PSJO) D EN1^PSJHL2(PSGP,"OD",+PSJO_"P") S P("NAT")=$P(^TMP("PSJCOM2",$J,+PSJO,.2),U,5) D EN1^PSJHL2(PSGP,"SN",ON55)
  1. K DA,DIK S DA(1)=DFN,DA=+ON55,DIK="^PS(55,"_DA(1)_",""IV"",",PSIVACT=1 D IX^DIK K DA,DIK
  1. K ^PS(53.1,"ACX",PSJORD,PSJO)
  1. Q
  1. ;
  1. DONE ; Clean up
  1. K PSGPD,PSGPDN,PSGSCH,PSIVACT,PSJNOO
  1. Q