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

PSJCOM.m

Go to the documentation of this file.
  1. PSJCOM ;BIR/CML - FINISH COMPLEX UNIT DOSE ORDERS ENTERED THROUGH OE/RR ;Jun 17, 2020@15:42:18
  1. ;;5.0;INPATIENT MEDICATIONS;**110,186,267,281,315,338,327,399,429**;16 DEC 97;Build 2
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ; Reference to ^VALM1 via DBIA 10116
  1. ; Reference to ^PS(55 via DBIA 2191
  1. ; Reference to ^%DTC via DBIA 10000
  1. ; Reference to ^%RCR via DBIA 10022
  1. ; Reference to ^DIR via DBIA 10026
  1. ; Reference to ^TIUEDIT via DBIA 2410
  1. ; Reference to ^TMP("PSODAOC",$J) via DBIA 6071
  1. ;
  1. UPD ;
  1. Q:'PSJCOM
  1. M ^TMP("PSJCOM",$J,+PSGORD)=^PS(53.1,+PSGORD)
  1. I PSGST="",(PSGSCH="NOW"!(PSGSCH="ONCE")) S PSGST="O"
  1. 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
  1. I $D(PSGSI),$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S ^TMP("PSJCOM",$J,+PSGORD,6)=PSGSI
  1. 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)=""
  1. S:$D(PSGSCH) $P(^TMP("PSJCOM",$J,+PSGORD,2),"^")=PSGSCH
  1. S:$D(PSGIND) $P(^TMP("PSJCOM",$J,+PSGORD,18),"^")=PSGIND ;*399-IND
  1. I PSGSM,PSGOHSM'=PSGHSM S $P(^TMP("PSJCOM",$J,+PSGORD,0),"^",5)=PSGSM,$P(^TMP("PSJCOM",$J,+PSGORD,0),"^",6)=PSGHSM K PSGOHSM
  1. W "."
  1. 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 "."
  1. ; Above code added to update file 53.1.
  1. S PSGOEEWF="^TMP(""PSJCOM"",$J,+PSGORD,"
  1. 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
  1. S PSGND=$G(^TMP("PSJCOM",$J,+PSGORD,0)),X=$P(PSGND,U,24)
  1. S PSJOWALL=+$G(^PS(55,PSGP,5.1))
  1. 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)
  1. 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
  1. S:$G(PSGRF)]"" ^TMP("PSJCOM",$J,+PSGORD,2.1)=$G(PSGDUR)_U_$G(PSGRMVT)_U_$G(PSGRMV)_U_$G(PSGRF) K PSGDUR,PSGRMVT,PSGRMV,PSGRF ;315,P429[Added $G(PSGRF)]
  1. I 'PSGOEAV D NEWNVAL(PSGORD,$S(+PSJSYSU=3:22005,1:22000))
  1. I $D(^PS(53.45,DUZ,5,1,0)) D FILESI^PSJBCMA5(PSGP,PSGORD) N SIARRAY S SIARRAY="" D NEWNVAL^PSGAL5(PSGORD,6000,"SPECIAL INSTRUCTIONS",,.SIARRAY)
  1. I PSGOEAV,+PSJSYSU=3 D VFY Q
  1. I PSGOEAV,$G(PSJRNF) D VFY
  1. Q
  1. VFY ; change status, move to 55, and change label record
  1. Q:'PSJCOM
  1. S ^TMP("PSODAOC",$J,"IP IEN")=PSGORD
  1. D SETOC^PSJNEWOC(PSGORD)
  1. I '$D(^TMP("PSJCOM",$J,+PSGORD)) M ^TMP("PSJCOM",$J,+PSGORD)=^PS(53.1,+PSGORD)
  1. NEW PSJDOSE,PSJDSFLG
  1. D DOSECHK^PSJDOSE
  1. 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)
  1. . S PSGOEEF(109)=1
  1. . S PSJACEPT=0
  1. D DDCHK G:CHK DONE
  1. ;; START NCC REMEDIATION >> 327*RJS
  1. N CLOZFLG S CLOZFLG=$$ISCLOZ^PSJCLOZ(+PSGORD)
  1. I CLOZFLG,'$G(^TMP("PSJCOM",$J,+PSGORD,"SAND")) D G:CHK DONE
  1. .S DIR(0)="N^12.5:3000:1",DIR("A")="CLOZAPINE dosage (mg/day) ? " D ^DIR K DIR I $D(DIRUT) S CHK=1 Q ;G DONE:$G(CHK)
  1. .S (^TMP("PSJCOM",$J,+PSGORD,"SAND"),PSOSAND)=X
  1. ;; END NCC REMEDIATION >> 327*RJS
  1. W !,"...a few moments, please..."
  1. I PSGORD["P" D
  1. . S PSGORDP=PSGORD ;Used in ACTLOG to update activity log in ^TMP
  1. . I '$D(^TMP("PSJCOM2",$J,+PSGORD)) D Q
  1. .. NEW PSGX S PSGX=$G(^TMP("PSJCOM",$J,+PSGORD,2.5)),PSGRSD=$P(PSGX,U),PSGRFD=$P(PSGX,U,3)
  1. .. S $P(^TMP("PSJCOM",$J,+PSGORD,0),"^",9)="A" W "." ;D ^PSGOT
  1. . NEW PSGX S PSGX=$G(^TMP("PSJCOM2",$J,+PSGORD,2.5)),PSGRSD=$P(PSGX,U),PSGRFD=$P(PSGX,U,3)
  1. . S $P(^TMP("PSJCOM2",$J,+PSGORD,0),"^",9)="A" W "." ;D ^PSGOT
  1. D NEWNVAL(+PSGORD,(PSJSYSU*10+22000)) W "."
  1. S VND4=$S('$D(^TMP("PSJCOM2",$J,+PSGORD)):$G(^TMP("PSJCOM",$J,+PSGORD,4)),1:$G(^TMP("PSJCOM2",$J,+PSGORD,4)))
  1. I $G(PSGRSD) D
  1. . S PSGRSD=$$ENDTC^PSGMI(PSGRSD) D NEWNVAL(PSGORD,6090,"Requested Start Date",PSGRSD)
  1. . S PSGRFD=$$ENDTC^PSGMI(PSGRFD) D NEWNVAL(PSGORD,6090,"Requested Stop Date",PSGRFD)
  1. N DUR,DURORD S DURON=$S($G(ON)&($G(PSGORD)["U"):ON,$G(PSGORD):PSGORD,1:"") Q:'DURON D
  1. . 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:"")
  1. I DUR]"" S $P(^TMP("PSJCOM2",$J,+PSGORD,2.5),"^",2)=DUR
  1. ;D:$D(PSGORDP) ACTLOG(PSGORDP,PSGP,PSGORD)
  1. K PSGRSD,PSGRFD,PSGALFN
  1. NEW X S X=0 I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S X=1
  1. I +PSJSYSU=3,PSGORD'["O",$S(X:0,'$P(VND4,"^",16):1,1:$P(VND4,"^",15)) ;D EN^PSGPEN(+PSGORD)
  1. S:'$P(VND4,U,+PSJSYSU=3+9) $P(VND4,U,+PSJSYSU=3+9)=+$P(VND4,U,+PSJSYSU=3+9)
  1. 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)=""
  1. S $P(VND4,"^",PSJSYSU,PSJSYSU+1)=DUZ_"^"_PSGDT
  1. S:'$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM",$J,+PSGORD,4)=VND4 S:$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM2",$J,+PSGORD,4)=VND4
  1. W:'$D(PSJSPEED) ! W !,"ORDER VERIFIED.",!
  1. I CLOZFLG,$L($G(ANQDATA)) S ^TMP("PSJCOM",$J,+PSGORD,"ANQDATA")=ANQDATA
  1. I '$D(PSJSPEED) K DIR S DIR(0)="E" D ^DIR K DIR
  1. S VALMBCK="Q"
  1. S ^TMP("PSJCOM",$J)="A" S:$D(^TMP("PSJCOM2",$J,+PSGORD)) ^TMP("PSJCOM2",$J)="A"
  1. ;
  1. DONE ;
  1. W:CHK !!,"...order NOT verified..."
  1. I '$D(PSJSPEED),'CHK,+PSJSYSU=3,$G(PSJPRI)="D" D
  1. .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
  1. .Q:Y="N"
  1. .D MAIN^TIUEDIT(3,.TIUDA,PSGP,"","","","",1)
  1. S VALMBCK="Q" K CHK,DA,DIE,F,DP,DR,ND,PSGAL,PSGODA,PSJDOSE,PSJVAR,VND4,X,%X,%Y,Q,QQ Q
  1. ;
  1. DDCHK ; dispense drug check
  1. 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)
  1. S PSGPD=$G(@(DRGF_".2)"))
  1. S CHK=$S('$$DDOK^PSGOE2(DRGF_"1,",PSGPD):7,1:0)
  1. Q:CHK=0
  1. W $C(7),!!,"This order must have at least one valid, active dispense drug to be verified."
  1. ;
  1. CONT() ;
  1. NEW DIR,DIRUT,Y
  1. W ! K DIR,DIRUT
  1. S DIR(0)="Y",DIR("A")="Would you like to continue verifying the order",DIR("B")="No"
  1. D ^DIR
  1. Q Y
  1. ;
  1. NEWNVAL(PSGALORD,PSGALC,PSGFLD,PSGOLD) ;
  1. ;
  1. ;Where PSGALORD = PSGORD (Required)
  1. ; PSGALC = ACTIVITY CODE FROM #53.3 (Required)
  1. ; PSGFLD = FIELD THAT CHANGED (Free text, optional)
  1. ; PSGOLD = THE FIELDS OLD DATA VALUE (Free text, optional)
  1. ;
  1. ;N PSGALORD,PSGALC,PSGFLD,PSGOLD
  1. ;
  1. ; Create 0 node activity log for order if none exists, and get next entry number
  1. I '$D(^TMP("PSJCOM2",$J,+PSGALORD)) D Q
  1. . 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
  1. . ;Set up data to be held in activity log record
  1. . D NOW^%DTC S PSGDT=+$E(%,1,12)
  1. . I $L($G(PSGOLD))>170 S PSGOLD=$E(PSGOLD,1,167)_"..." ; Use of ... indicates old data field was greater than 170 characters
  1. . 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:"")
  1. . ; Create activity log entry
  1. . S ^TMP("PSJCOM",$J,+PSGALORD,"A",PSGAL("N"),0)=Q
  1. 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
  1. ;Set up data to be held in activity log record
  1. D NOW^%DTC S PSGDT=+$E(%,1,12)
  1. I $L($G(PSGOLD))>170 S PSGOLD=$E(PSGOLD,1,167)_"..." ; Use of ... indicates old data field was greater than 170 characters
  1. 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:"")
  1. ; Create activity log entry
  1. S ^TMP("PSJCOM2",$J,+PSGALORD,"A",PSGAL("N"),0)=Q
  1. Q