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

PSBVDLVL.m

Go to the documentation of this file. 
  1. PSBVDLVL ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS ;Mar 2004
  1.  ;;3.0;BAR CODE MED ADMIN;**6,3,12,11,13,32,25**;Mar 2004;Build 6
  1.  ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1.  ;
  1.  ;
  1.  ; Reference/IA
  1.  ; $$GET^XPAR/2263
  1.  ; 
  1. EN(RESULTS,DFN,PSBXOR,PSBTYPE,PSBADMIN,PSBTAB,PSBUID,PSBASTS,PSBORSTS,PSBRMV) ;
  1.  ;
  1.  ; RPC: PSB VALIDATE ORDER
  1.  ;
  1.  ; Description: Final check of order against an actual administration
  1.  ;              date/time used immediately after scanned med has been
  1.  ;              validated to be a good un-administered order.
  1.  ;
  1.  K PSBTST
  1.  N PSBFLAG
  1.  I PSBRMV="I" D GETOHIST^PSBRPC2(.PSBTST,DFN,PSBXOR_PSBTYPE) S I=0 F  S I=$O(PSBTST(I)) Q:I=""  I $P(PSBTST(I),U,5)="I" S RESULTS(0)=1,RESULTS(1)="-2^" K PSBTST Q
  1.  K PSBOKAY D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBXOR_PSBTYPE) S PSB=0
  1.  S RESULTS(0)=1,RESULTS(1)="-1^***Unable to determine administration" ; Default Flag will be overwritten by anything
  1.  D NOW^%DTC
  1.  I ((PSBOSTS="A")!(PSBOSTS="R"))&(PSBOSP<%) S PSBOSTS="E"
  1.  I PSBORSTS'=PSBOSTS,((PSBSCHT'="O")&(PSBOSTS'="E")) S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-2^ORDER STATUS MISMATCH" Q
  1.  I ((PSBTAB="UDTAB")!(PSBTAB="PBTAB")),((PSBRMV="RM")!(PSBRMV="N")) D  Q
  1.  .S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="0^OKAY TO REMOVE"  ; patch removal does not follow rest of validte rules
  1.  .I PSBASTS="" Q  ;status is not given - don't check for missmatch
  1.  .I $D(^PSB(53.79,"AORD",DFN,PSBXOR_PSBTYPE,+PSBADMIN)) S X=$O(^PSB(53.79,"AORD",DFN,PSBXOR_PSBTYPE,+PSBADMIN,"")) I $P($G(^PSB(53.79,+X,0)),U,9)'=PSBASTS  S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-2^Admin status mismatch"
  1.  I PSBTYPE="V",PSBSCHT'="P",((PSBUID="")!(PSBUID["WS")) S RESULTS(0)=1,RESULTS(1)="0^Okay to administer" Q:PSBTAB="IVTAB"
  1.  I PSBTYPE="V",PSBUID'="" D  Q:PSBTAB="IVTAB"  ; validate IV bags Piggybacks have additional tests
  1.  .S PSB=0,PSBSUID=PSBUID D EN^PSBPOIV(DFN,PSBXOR_PSBTYPE)
  1.  .S X="" F  S X=$O(^TMP("PSBAR",$J,X)) Q:X=""  D
  1.  ..I PSBSUID'=X Q
  1.  ..S PSBUIDS=^TMP("PSBAR",$J,X)
  1.  ..I $P(PSBUIDS,U,2)="I"!($P(PSBUIDS,U,2)="S") S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="0^Okay to administer" Q  ; is infusing or stopped
  1.  ..I $P(PSBUIDS,U,1)="I" S Y=$P(^TMP("PSBAR",$J,"I"),U,2) D DD^%DT S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)=$P(^TMP("PSBAR",$J,"I"),U,3,99)_"  "_Y Q
  1.  ..I $P(PSBUIDS,U,1)["W" S PSBWS=$P(PSBUIDS,U,1) F PSBWM=2:1 Q:$P(PSBWS,";",PSBWM)=""  D
  1.  ...S Y=$P(^TMP("PSBAR",$J,"W",$P(PSBWS,";",PSBWM)),U,2) D DD^%DT S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)=$P(^TMP("PSBAR",$J,"W",$P(PSBWS,";",PSBWM)),U,3,99)_" "_Y
  1.  ..S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="0^Okay to administer"
  1.  .K ^TMP("PSBAR",$J)
  1.  ;
  1.  ; no IV orders
  1.  ;
  1.  D NOW^%DTC
  1.  I PSBOSTS="H" S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="0^Order is on Provider Hold" Q
  1.  I PSBSCHT'="O"&(%<($$FMADD^XLFDT(PSBOST,"","",$$GET^XPAR("ALL","PSB ADMIN BEFORE")*-1))) S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-1^Order Not Active" Q
  1.  I (%>PSBOSP) S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-1^Order Not Active" Q
  1.  I (PSBSCHT="C")!((PSBSCHT="P")&(PSBDOSEF="PATCH")) D
  1.  .S PSBOKAY="0^Okay to administer"
  1.  .I PSBASTS["*UNKNOWN*" S PSBOKAY="-1^This administration has *UNKNOWN* status" Q
  1.  .I PSBOSTS'="A",PSBOSTS'="R",PSBOSTS'="O" S PSBOKAY="-1^Order Not Active" Q
  1.  .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE" Q
  1.  .S PSBFLAG=0 I PSBRMV="M"!(PSBRMV="H")!(PSBRMV="R") S PSBFLAG=1
  1.  .I $D(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE)) D  Q:X
  1.  ..S X=0,PSBLADT=$O(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE,""),-1),PSBLAIEN=$O(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE,PSBLADT,""),-1)
  1.  ..I $P($G(^PSB(53.79,PSBLAIEN,0)),U,9)="G",$P($G(^PSB(53.79,PSBLAIEN,.5,1,0)),U,4)="PATCH",PSBFLAG=0 S X=1,PSBOKAY="-1^Previous patch has not been removed" Q
  1.  .I $D(^PSB(53.79,"AORD",DFN,PSBXOR_PSBTYPE,+PSBADMIN)) D  Q:+PSBOKAY<0
  1.  ..S X=$O(^PSB(53.79,"AORD",DFN,PSBXOR_PSBTYPE,+PSBADMIN,""))
  1.  ..L +^PSB(53.79,+X):1
  1.  ..I  L -^PSB(53.79,+X)
  1.  ..E  S PSBOKAY="-1^The "_$$GET1^DIQ(53.79,+X_",",.13)_" administration is being edited by another" Q
  1.  ..I $G(PSBASTS)]"" D  Q:+PSBOKAY<0
  1.  ...I $P($G(^PSB(53.79,+X,0)),U,9)="" Q
  1.  ...I $P($G(^PSB(53.79,+X,0)),U,9)'=PSBASTS S PSBOKAY="-2^Admin status mismatch" Q
  1.  .; Minutes before
  1.  .S PSBWIN1=$$GET^XPAR("DIV","PSB ADMIN BEFORE")*-1
  1.  .; Minutes After
  1.  .S PSBWIN2=$$GET^XPAR("DIV","PSB ADMIN AFTER")
  1.  .D NOW^%DTC S PSBMIN=$$DIFF^PSBUTL(PSBADMIN,%)
  1.  .; PENDING A PC SOLUTION!
  1.  .I PSBMIN<PSBWIN1 S PSBOKAY="1^Admin is "_(PSBMIN*-1)_" minutes before the scheduled administration time" Q
  1.  .I PSBMIN>PSBWIN2 S PSBOKAY="1^Admin is "_(PSBMIN)_" minutes after the scheduled administration time" Q
  1.  .S PSBOKAY="0^Okay to administer"
  1.  ; Validate a PRN Order
  1.  D:(PSBSCHT="P")
  1.  .I PSBOSTS'="A",PSBOSTS'="R",PSBOSTS'="O" S PSBOKAY="-1^Order Not Active" Q
  1.  .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE" Q
  1.  .I (+($G(PSBOKAY))<0)&(PSBDOSEF="PATCH") Q  ;A Patch may have to be removed.
  1.  .S PSBOKAY="1^"
  1.  .; Get Last Four Givens
  1.  .S PSBDT=""
  1.  .F  S PSBDT=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,PSBDT),-1) Q:PSBDT=""  D
  1.  ..S PSBDA=""
  1.  ..F  S PSBDA=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,PSBDT,PSBDA),-1) Q:'PSBDA  D
  1.  ...S (PSBCNT1,PSBCNT2,PSBCNT3)=0
  1.  ...S PSBLADT=$$GET1^DIQ(53.79,PSBDA_",",.06,"I")
  1.  ...S PSBSTUS=$$GET1^DIQ(53.79,PSBDA_",",.09)
  1.  ...S:PSBSTUS="" PSBSTUS="U"
  1.  ...S PSBSCH=$$GET1^DIQ(53.79,PSBDA_",",.12)
  1.  ...S PSBRSN=$$GET1^DIQ(53.79,PSBDA_",",.21)
  1.  ...S PSBINJ=$$GET1^DIQ(53.79,PSBDA_",",.16)
  1.  ...Q:$P(^PSB(53.79,PSBDA,0),U,9)="N"
  1.  ...F PSBZ=.5,.6,.7 F PSBY=0:0 S PSBY=$O(^PSB(53.79,PSBDA,PSBZ,PSBY)) Q:'PSBY  D
  1.  ....Q:'$D(^PSB(53.79,PSBDA,PSBZ,PSBY))
  1.  ....S PSBDD=$S(PSBZ=.5:53.795,PSBZ=.6:53.796,1:53.797)
  1.  ....S PSBUNIT=$$GET1^DIQ(PSBDD,PSBY_","_PSBDA_",",.03)
  1.  ....S PSBUNFR=$$GET1^DIQ(PSBDD,PSBY_","_PSBDA_",",.04)
  1.  ....I PSBZ=.5 S PSBCNT1=PSBCNT1+1
  1.  ....I PSBZ=.6 S PSBCNT2=PSBCNT2+1
  1.  ....I PSBZ=.7 S PSBCNT3=PSBCNT3+1
  1.  ...;Units given or free text not to display for multiple dispense drugs or additives and solution
  1.  ...I (PSBCNT1>1)!(PSBCNT2>0)!(PSBCNT3>0) S (PSBUNIT,PSBUNFR)=""
  1.  ...S X=PSBLADT_U
  1.  ...S X=X_PSBSTUS_U_PSBSCH_U_$G(PSBRSN)_U_$G(PSBINJ)_U_$G(PSBUNIT)_U_$G(PSBUNFR)
  1.  ...S PSBOKAY($O(PSBOKAY(""),-1)+1)=3_U_X
  1.  ...S:$D(PSBOKAY(4)) PSBDT=0
  1.  .S X1=$$LASTG^PSBCSUTL(DFN,+PSBOIT) I X1>0 S PSBOKAY($O(PSBOKAY(""),-1)+1)=4_U_X1
  1.  ; Validate a One-Time Order
  1.  D:PSBSCHT="O"
  1.  .S (PSBGVN,X,Y)=""
  1.  .F  S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)  Q:'X  F  S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y  I $P(^PSB(53.79,Y,.1),U)=PSBONX,"G"[$P(^PSB(53.79,Y,0),U,9) S PSBGVN=1,(X,Y)=0
  1.  .I PSBGVN S PSBOKAY="-1^Dose Already on medication Log" Q
  1.  .; One Time are automatically expired so we don't check STATUS here
  1.  .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE" Q
  1.  .S PSBOKAY="0^Okay to administer"
  1.  ; Validate an On Call Order
  1.  D:PSBSCHT="OC"
  1.  .S PSBOKAY="0^Okay to administer"
  1.  .S (PSBGVN,X,Y)=""
  1.  .F  S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)  Q:'X  F  S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y  I $P(^PSB(53.79,Y,.1),U)=PSBONX,"G"[$P(^PSB(53.79,Y,0),U,9) S PSBGVN=1,(X,Y)=0
  1.  .I PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) S PSBOKAY="-1^Dose Already on medication Log" Q
  1.  .I PSBOSTS'="A",PSBOSTS'="R",PSBOSTS'="O" S PSBOKAY="-1^Order Not Active" Q
  1.  .I PSBNGF S PSBOKAY="-1^marked DO NOT GIVE" Q
  1.  .I PSBGVN&($$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL"))&(PSBDOSEF="PATCH") S PSBOKAY="-1^Previous patch has not been removed" Q
  1.  .S PSBOKAY="0^Okay to administer"
  1.  ;
  1.  D:+PSBOKAY'<0
  1.  .N PSBDIFF,Y
  1.  .D:(PSBSCHT="C")!(PSBSCHT="OC"&('$G(PSBGVN)))
  1.  ..; On-call or cont and not on the log.
  1.  ..S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,""),-1)
  1.  ..;Check for the status of the medication and insert status in the text
  1.  ..I Y]"" S X=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,Y,""),-1),PSBSTUS=$P(^PSB(53.79,X,0),U,9)
  1.  ..S:Y']"" PSBSTUS=""
  1.  ..I PSBSTUS="N" D  Q:$G(PSBQUIT)
  1.  ...S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,Y,X),-1)
  1.  ...D:X']""
  1.  ....S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,Y),-1) I Y']"" S PSBQUIT=1 Q
  1.  ....S X=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,Y,""),-1),PSBSTUS=$P(^PSB(53.79,X,0),U,9)
  1.  ..S PSBDIFF=$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)
  1.  ..Q:PSBDIFF>7200  ; Greater than 2 hours
  1.  ..I (PSBSTUS="G")!(PSBSTUS="H")!(PSBSTUS="R")!(PSBSTUS="RM") D
  1.  ...S PSBSTUS=$$GET1^DIQ(53.79,X_",",.09)
  1.  ...I PSBSTUS'="" D
  1.  ....S Y="1^*** NOTICE, "_PSBOITX_" was "_PSBSTUS_" "_(PSBDIFF\60)_" minutes ago."
  1.  ....I +PSBOKAY=1 S PSBOKAY(1)=Y
  1.  ....E  S PSBOKAY=Y
  1.  ;
  1.  S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)=PSBOKAY
  1.  F X=1:1 Q:'$D(PSBOKAY(X))  S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)=PSBOKAY(X)
  1.  Q
  1.  ;