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

PSBML.m

Go to the documentation of this file.
  1. PSBML ;BIRMINGHAM/EFC-BCMA MED LOG FUNCTIONS ;03/06/16 3:06pm
  1. ;;3.0;BAR CODE MED ADMIN;**6,3,4,9,11,13,25,45,33,52,70,72,79,94,83,98**;Mar 2004;Build 2
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ; Reference/IA
  1. ; ^DPT/10035
  1. ; DIC(42/10039
  1. ; DIC(42/2440
  1. ; File 200/10060
  1. ; EN^PSJBCMA3/3320
  1. ; $$SITE^VASITE/10112
  1. ; ^XUSEC(/10076
  1. ;
  1. ;*70 - store clinic name to admin location if exists.
  1. ; - add witness duz, dt/tm for high risk/alert drug, Order level
  1. ; HR code, and a witnessed y/n flag to MEDLOG file.
  1. ;*83 - store MRR code to DD multiple .06 field, to update AMRR xref
  1. ; - store Scheduled Removal time in a new field in 53.79
  1. ; - change offset of incoming array from 10th to 11th piece.
  1. ;
  1. RPC(RESULTS,PSBHDR,PSBREC) ;BCMA MedLog Filing
  1. K PSBEDTFL
  1. S PSBEDTFL=0
  1. N PSBORD,PSBTRAN,PSBFDA,PSBMES ;Add PSBMES variable for PSB*3*52
  1. N PSBCLIN,PSBWITN,PSBWITCM,PSBWITHR,PSBWITFL,LOC ;*70
  1. N PSBACTN ;used for trigger xref code *83
  1. K PSBIEN,PSBHL7,%,PSBAUDIT,PSBINST
  1. S PSBIEN=$P(PSBHDR,U,1)
  1. S PSBTRAN=$P(PSBHDR,U,2),PSBHL7=PSBTRAN
  1. S PSBINST=$P($G(PSBHDR),U,3)
  1. ;*70 witness fields
  1. S PSBWITN=+$P(PSBHDR,U,4) ;init witness duz var
  1. S PSBWITCM=$P(PSBHDR,U,5) ;init witness comment
  1. S PSBWITHR=+$P(PSBHDR,U,6) ;init witness HR order level
  1. S PSBWITFL=$S(PSBWITN:1,1:0) ;init witnessed?
  1. I PSBWITN="",PSBWITHR=3 D Q
  1. .S RESULTS(0)=1
  1. .S RESULTS(1)="-1^A Witness is required, however Witness information was null."
  1. ;PSB*3*45 We should be recording the first entry in the audit log.
  1. ;S PSBAUDIT=$S(PSBIEN="+1":0,1:1)
  1. S PSBAUDIT=1
  1. D NOW^%DTC S PSBNOW=%
  1. I $D(^XUSEC("PSB STUDENT",DUZ)),PSBINST="" S RESULTS(0)=1,RESULTS(1)="-1^Instructor not present" Q
  1. I $D(^XUSEC("PSB STUDENT",DUZ)),'$D(^XUSEC("PSB INSTRUCTOR",PSBINST)) S RESULTS(0)=1,RESULTS(1)="-1^Instructor doesn't have authority" Q
  1. S PSBINST(0)=$$GET1^DIQ(200,PSBINST_",",.01)
  1. I PSBTRAN="ADD COMMENT" D COMMENT^PSBML1 Q
  1. I PSBTRAN="PRN EFFECTIVENESS" D PRN^PSBML1 Q
  1. ;
  1. ;update medlog rec
  1. UPD I PSBTRAN="UPDATE STATUS" D Q
  1. .K PSBTAB,PSBUID
  1. .S PSBACTN=PSBREC(0) ;var for trigger code for Variance calcs *83
  1. .I '$D(^PSB(53.79,PSBIEN)) D Q
  1. ..S RESULTS(0)=1
  1. ..S RESULTS(1)="-1^Administration is at an UNKNOWN STATUS"
  1. .D UPDATED^PSBML2
  1. ;
  1. ;edit Medlog rec
  1. EDITML I PSBTRAN="EDIT" D EDIT^PSBML2 Q
  1. ;
  1. ;SAGG
  1. N PSBWARD S PSBWARD=$G(^DPT(+$G(PSBREC(0)),.1),"UNKNOWN"),^PSB("SAGG",PSBWARD,DT)=$G(^PSB("SAGG",PSBWARD,DT))+1
  1. ;*70 save clinic name if exists before manipulating PSBREC(1) param
  1. S PSBCLIN=$P(PSBREC(1),U,2) I PSBCLIN="" S PSBCLIN=$S($G(PSBCLIEN):$P($G(^SC(+PSBCLIEN,0)),"^"),($G(PSBCLORD)]""):PSBCLORD,1:"")
  1. S PSBREC(1)=$P(PSBREC(1),U)
  1. ;
  1. ;pre-existing psbrec(1) manipulation logic to *70
  1. I PSBREC(1)?1U1";"1.6N S PSBREC(1)=$P(PSBREC(1),";",1)_$E(PSBREC(1))
  1. D PSJ1^PSBVT(PSBREC(0),$P(PSBREC(1),";",2)_$P(PSBREC(1),";",1))
  1. S PSBTAB=$P(PSBREC(9),U,1),PSBUID=$P(PSBREC(9),U,2)
  1. MEDP D:PSBTRAN="MEDPASS"
  1. .K PSBDIV,PSBON,PSBXDT,PSBYZ
  1. .S PSBACTN=PSBREC(3) ;var for trigger code for Variance calcs *83
  1. .I ((PSBDOSEF["PATCH")!(PSBMRRFL)),(PSBREC(3)="G") D Q:+$G(RESULTS(1))<0 ;add MRR flag to test *83
  1. ..S PSBXDT="" F S PSBXDT=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBXDT)) Q:PSBXDT="" D Q:+$G(RESULTS(1))<0
  1. ...S PSBYZ="" F S PSBYZ=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBXDT,PSBYZ)) Q:'PSBYZ I ("G"[$$GET1^DIQ(53.79,PSBYZ,.09,"I")) D Q
  1. ....S:($$GET1^DIQ(53.79,PSBYZ,.09,"I")="G") RESULTS(0)=1,RESULTS(1)="-1^Previous administration has not been removed. Administration canceled.^" ;make generic verbiage *83
  1. ....S:($$GET1^DIQ(53.79,PSBYZ,.09,"I")="")&(($$GET1^DIQ(53.79,PSBYZ,.07,"I")'=DUZ)&('$D(^XUSEC("PSB MANAGER",DUZ)))) RESULTS(0)=1,RESULTS(1)="-1^Patch status ""*UNKNOWN*"". Administration canceled."
  1. .I PSBREC(7)="BCMA/CPRS Interface Entry." S PSBNOW=PSBREC(5) ;MOB
  1. .F X=0:1:9 S PSBREC(X)=$G(PSBREC(X))
  1. .I PSBREC(1)?1U1";".N S PSBREC(1)=$P(PSBREC(1),";",2)_$P(PSBREC(1),";",1)
  1. .I PSBREC(1)["V",+PSBREC(5)>0,+$P(PSBREC(5),".",2)=0,PSBIVT'["P" D NOW^%DTC S PSBREC(5)=$P(PSBREC(5),".",1)_"."_$P(%,".",2)
  1. .I $P(PSBREC(9),U,1)="IVTAB",$P(PSBREC(9),U,2)="" S PSBUID=$$GETWSID^PSBVDLU2(PSBREC(0),PSBREC(1))
  1. .I $P(PSBREC(9),U,1)="PBTAB",$P(PSBREC(9),U,2)="",PSBREC(1)'["U",PSBREC(3)'="M",PSBREC(3)'="R",PSBREC(3)'="H" S PSBUID=$$GETWSID^PSBVDLU2(PSBREC(0),PSBREC(1))
  1. .;OnCal
  1. .D:PSBREC(2)="OC"
  1. ..S X=$O(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),"")) Q:X=""
  1. ..S Y=$O(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),X,0))
  1. ..I $P(^PSB(53.79,Y,0),U,9)="G"&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) D ERR(1,"On-Call already given")
  1. .;1x
  1. .D:PSBREC(2)="O"
  1. ..S X=$O(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),"")) Q:X=""
  1. ..S Y=$O(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),X,0))
  1. ..I $P(^PSB(53.79,Y,0),U,9)="G" D ERR(1,"One Time already Given")
  1. .;PRN
  1. .I PSBREC(2)="P",PSBREC(3)'="M",$P(PSBREC(9),U,1)'="IVTAB" D
  1. ..I PSBREC(6)="" D ERR(1,"PRN Medications MUST Have a PRN Reason")
  1. ..I PSBREC(5)]"" D ERR(1,"PRN Orders don't have scheduled times")
  1. ..I PSBREC(3)'="G" D ERR(1,"PRN Orders cannot be marked NOT Given")
  1. .;Cnt
  1. .I PSBREC(2)="C",PSBTAB'="IVTAB" D
  1. ..D:PSBREC(5)="" ERR(1,"Continuous Order needs admin time")
  1. ..D:PSBREC(6)]"" ERR(1,"No PRN Reason allowed on Continuous Orders")
  1. .I PSBREC(2)="C",$D(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),+PSBREC(5))),PSBIEN="+1" D K PSBADMBY,PSBADMAT Q:PSBSIEN="" Q:$P(^PSB(53.79,PSBSIEN,0),U,9)'="N"
  1. ..S PSBSIEN=$O(^PSB(53.79,"AORD",PSBREC(0),PSBREC(1),PSBREC(5),""))
  1. ..I PSBSIEN]"" I '(($P(^PSB(53.79,PSBSIEN,0),U,7)=DUZ)!($D(^XUSEC("PSB MANAGER",DUZ)))) S PSBSIEN=""
  1. ..I PSBSIEN']"" S RESULTS(0)=2,RESULTS(1)="-2^Error Filing Transaction MEDPASS",RESULTS(2)="The PSB MANAGER key is required to modify this scheduled admin" Q
  1. ..D:$P(^PSB(53.79,PSBSIEN,0),U,9)'="N"
  1. ...K PSBINCX I $P(^PSB(53.79,PSBSIEN,0),U,9)="" S PSBINCX=PSBSIEN L +^PSB(53.79,PSBINCX):1 Q:'$T L -^PSB(53.79,PSBINCX)
  1. ...S Y=$P(^PSB(53.79,PSBSIEN,0),U,6) D DD^%DT S PSBADMAT=Y
  1. ...S PSBADMBY=$$GET1^DIQ(200,$P(^PSB(53.79,PSBSIEN,0),U,7),.01,)
  1. ...S RESULTS(0)=3,RESULTS(1)="-2^Error Filing Transaction MEDPASS"
  1. ...S RESULTS(2)="Continuous Administration Date/Time already on file."
  1. ...S RESULTS(3)="Administered by "_PSBADMBY_" at "_PSBADMAT_"."
  1. ...I $D(XWB) S RESULTS(0)=RESULTS(0)+2,RESULTS(4)=" ",RESULTS(5)=" VDL will now be updated."
  1. .;Non Given
  1. .I PSBREC(3)'="G",PSBREC(3)'="M",PSBUID'["V",PSBUID'["W" D
  1. ..I PSBREC(7)="",PSBTAB'="IVTAB" D ERR(1,"Comment needed if Not Marked Given")
  1. ..I PSBREC(7)="",PSBTAB="IVTAB" D ERR(1,"Comment needed if Not Marked Completed")
  1. .S:PSBREC(3)="H" PSBREC(7)="Held: "_PSBREC(7) ;.3
  1. .S:PSBREC(3)="R" PSBREC(7)="Refused: "_PSBREC(7) ;.3
  1. .S:PSBREC(3)="S" PSBREC(7)="Stopped: "_PSBREC(7) ;.3
  1. .;Valid?
  1. .I $G(PSBSIEN)'="" I $D(^PSB(53.79,PSBSIEN,0)) I $P(^PSB(53.79,PSBSIEN,0),U,9)="N" S PSBIEN=+PSBSIEN_",",$P(PSBHDR,U)=PSBIEN,PSBTRAN="UPDATE STATUS",PSBAUDIT=1 ;do UPDATE
  1. .D:PSBIEN="+1" ;New fields only?
  1. ..D VAL(53.79,PSBIEN,.01,"`"_PSBREC(0)) ;Patn
  1. ..S LOC=$G(^DPT(PSBREC(0),.1))_" "_$G(^(.101)) ;Ward Room/Bed LOC
  1. ..S:PSBCLIN]"" LOC=PSBCLIN ;If clinic order use clin name *70
  1. ..D VAL(53.79,PSBIEN,.02,LOC) ;Patn Location LOC
  1. ..D:$G(^DPT(PSBREC(0),.1))'=""
  1. ...S Y=$O(^DIC(42,"B",$G(^DPT(PSBREC(0),.1)),"")),Y=$$GET1^DIQ(42,Y,.015,"I"),PSBDIV=$$SITE^VASITE(DT,Y)
  1. ...D VAL(53.79,PSBIEN,.03,"`"_$P(PSBDIV,U,1)) ;Div
  1. ..D VAL(53.79,PSBIEN,.04,PSBNOW) ;Entered dt/tm
  1. ..D VAL(53.79,PSBIEN,.05,"`"_DUZ) ;Entered by duz
  1. ..D VAL(53.79,PSBIEN,.06,PSBNOW) ;Admin dt/tm
  1. ..D VAL(53.79,PSBIEN,.07,"`"_DUZ) ;Admin By duz
  1. ..D VAL(53.79,PSBIEN,.08,"`"_PSBREC(4)) ;Orderable Item
  1. ..D VAL(53.79,PSBIEN,.11,PSBREC(1)) ;Ord file 55 IEN
  1. ..D VAL(53.79,PSBIEN,.12,PSBREC(2)) ;Ord Schd Type
  1. ..D VAL(53.79,PSBIEN,.13,PSBREC(5)) ;Schd Admin dt/tm
  1. ..I $P($G(PSBREC(10)),".",2)]"" D
  1. ...D VAL(53.79,PSBIEN,.17,PSBREC(10)) ;Schd Remove dt/tm
  1. ..D:PSBTAB'="UDTAB" VAL(53.79,PSBIEN,.26,PSBUID) ;IV Bag ID
  1. ..D:PSBTAB="IVTAB" VAL(53.79,PSBIEN,.13,"") ;Schd Admdt/tm null
  1. ..D:PSBREC(1)?.N1"U" VAL(53.79,PSBIEN,.15,PSBDOSE) ;UD Dosage
  1. ..D:PSBREC(1)?.N1"V" VAL(53.79,PSBIEN,.35,PSBIFR) ;IV Infuse Rate
  1. ..I PSBWITHR>1,(PSBREC(3)="G")!(PSBREC(3)="I") D ;Witness logic and Give? *70
  1. ...D:PSBWITN VAL(53.79,PSBIEN,.28,PSBNOW) ;Witness dt/time
  1. ...D:PSBWITN VAL(53.79,PSBIEN,.29,"`"_PSBWITN) ;Witness duz
  1. ...D:PSBWITCM]"" VAL(53.79,PSBIEN,.31,PSBWITCM) ;Witness comment
  1. ...D VAL(53.79,PSBIEN,.32,PSBWITHR) ;Witness HR ord code
  1. ...D VAL(53.79,PSBIEN,.33,PSBWITFL) ;Witnessed? flag
  1. .;
  1. .;Overwrite fields below, rec already exists
  1. .I PSBREC(3)="G"!(PSBREC(3))="C" D ;Gvn/Completed?
  1. ..D VAL(53.79,PSBIEN,.06,PSBNOW) ;Admin dt/tm
  1. ..D VAL(53.79,PSBIEN,.07,"`"_DUZ) ;Admin By duz
  1. .; set Derm/Inj site fields *83
  1. .I PSBREC(8)]"" D
  1. ..N SITETXT,SITECD
  1. ..S SITETXT=$P(PSBREC(8),"|",1),SITECD=$P(PSBREC(8),"|",2)
  1. ..I SITECD="D" D ;If dermal, else assume inj site
  1. ...D VAL(53.79,PSBIEN,.18,SITETXT) ;Dermal site
  1. ..E D
  1. ...D VAL(53.79,PSBIEN,.16,SITETXT) ;Inject site
  1. .;
  1. .D:'$G(PSBMMEN) VAL(53.79,PSBIEN,.09,PSBREC(3)) ;AStats
  1. .I PSBREC(6)]"" D ;PRN reason?
  1. ..D VAL(53.79,PSBIEN,.21,$P(PSBREC(6),U)) ;reason dt/tm
  1. ..D VAL(53.79,PSBIEN,.27,$P(PSBREC(6),U,2)) ;PRN reason
  1. .D:PSBREC(7)]""
  1. ..D VAL(53.793,"+2,"_PSBIEN,.01,PSBREC(7)) ;Comment
  1. ..D VAL(53.793,"+2,"_PSBIEN,.02,"`"_DUZ) ;comnt person duz
  1. ..D VAL(53.793,"+2,"_PSBIEN,.03,PSBNOW) ;comnt dt/time
  1. .;
  1. .;DD/SOL/ADD
  1. .I PSBREC(3)="G"!(PSBREC(3)="I")!(PSBREC(3)="H")!(PSBREC(3)="R")!(PSBREC(3)="M") D ;given/action stat codes?
  1. ..I PSBTRAN="UPDATE STATUS" K ^PSB(53.79,+PSBIEN,.5),^PSB(53.79,+PSBIEN,.6),^PSB(53.79,+PSBIEN,.7)
  1. ..;move DD segments to element 11..n No longer 10th *83
  1. ..K PSBCNT,PSBIENS
  1. ..F PSBCNT=11:1 Q:'$D(PSBREC(PSBCNT)) D
  1. ...S Y=$P(PSBREC(PSBCNT),U)
  1. ...S PSBDD=$S(Y="DD":53.795,Y="ADD":53.796,Y="SOL":53.797,1:0)
  1. ...Q:'PSBDD
  1. ...S PSBIENS="+"_PSBCNT_","_PSBIEN
  1. ...D VAL(PSBDD,PSBIENS,.01,"`"_$P(PSBREC(PSBCNT),U,2))
  1. ...D VAL(PSBDD,PSBIENS,.02,$P(PSBREC(PSBCNT),U,3))
  1. ...D:PSBDD=53.795 VAL(PSBDD,PSBIENS,.02,$P(PSBREC(PSBCNT),U,3))
  1. ...D:PSBDD=53.796!(PSBDD=53.797) VAL(PSBDD,PSBIENS,.02,$P(PSBREC(PSBCNT),U,4)) ;Store units in Units ordered field, PSB*3*72
  1. ...D:PSBREC(3)="G"!(PSBREC(3)="I") VAL(PSBDD,PSBIENS,.03,$P(PSBREC(PSBCNT),U,4)) ;only store units given when infusing or given, PSB*3*72
  1. ...D:(PSBTAB="UDTAB")!(PSBTAB="PBTAB") VAL(PSBDD,PSBIENS,.04,$E($P(PSBREC(PSBCNT),U,5),1,40))
  1. ...D VAL(PSBDD,PSBIENS,.05,$P(PSBREC(PSBCNT),U,7)) ;HR ind *70
  1. ...;.06 field only valid for Unit dose DD type, not for IV's *83
  1. ...D:PSBDD=53.795 VAL(PSBDD,PSBIENS,.06,$P(PSBREC(PSBCNT),U,8)) ;MRR
  1. .;Modify Filing Transaction Medpass error message too inclde details - PSB*3*52
  1. .I $O(RESULTS("")) D Q
  1. ..N PSBERR
  1. ..I $D(PSBMES) D
  1. ...S RESULTS(1)="-2^***Your documentation is NOT being recorded in the patient record.***",RESULTS(2)=""
  1. ...S RESULTS(3)="Please write down the information (below) AND contact your BCMA Coordinator or IT Support for assistance:",RESULTS(4)=""
  1. ...S RESULTS(5)="Error(s) Filing Transaction MEDPASS"
  1. ..S PSBERR=0 F S PSBERR=$O(PSBMES(PSBERR)) Q:PSBERR="" D
  1. ...S RESULTS($O(RESULTS(""),-1)+1)=PSBMES(PSBERR),RESULTS(0)=$O(RESULTS(""),-1)
  1. .;
  1. .D FILEIT
  1. .;
  1. .;PSB*3*33
  1. .D:((PSBREC(2)="O")!($$ONE^PSJBCMA(PSBREC(0),PSBREC(1))="O"))&(PSBREC(3)="G") EXPIRE^PSBML1 ;1x exp?
  1. .;D:(PSBREC(2)="O")&(PSBREC(3)="G") EXPIRE^PSBML1 ;1x exp? ;Remove second call, which will always be made if above call is true, PSB*3*98
  1. .I $P(RESULTS(0),U,1)=1,PSBTAB'="UDTAB",PSBUID]"",PSBUID'["WS" S PSBON=+PSBREC(1) D EN^PSJBCMA3(PSBREC(0),PSBON,PSBUID,PSBREC(3),PSBNOW)
  1. Q
  1. BCBU ;HL7,NatContng
  1. Q:+$G(RESULTS(0))'>0
  1. N PSBIEN1 S PSBIEN1=$S($P(PSBIEN,",",2)'="":+$P(PSBIEN,",",2),$G(PSBIEN)="+1":PSBIEN(1),1:+$G(PSBIEN))
  1. I $G(PSBIEN1)="" S RESULTS(0)=1,RESULTS(1)="-1^Contingency NOT processed" Q
  1. I $G(PSBIEN)="+1" S PSBHL7="MEDPASS"
  1. E S:$G(PSBHL7)="" PSBHL7="UPDATE STATUS"
  1. D:('$D(Y(0))!($G(Y(0))="SAVE")!($G(Y(0))="YES")) EN^PSBSVHL7(+PSBIEN1,PSBHL7),MEDL^ALPBCBU(+PSBIEN1) K PSBHL7
  1. ;<<HDR-VDEF(frm *3)
  1. Q
  1. VAL(PSBDD,PSBIEN,PSBFLD,PSBVAL) ;
  1. K ^TMP("DIERR",$J),PSBRET
  1. D VAL^DIE(PSBDD,PSBIEN,PSBFLD,"F",PSBVAL,.PSBRET,"PSBFDA")
  1. I PSBRET="^" F X=0:0 S X=$O(^TMP("DIERR",$J,X)) Q:'X D ERR(2,^TMP("DIERR",$J,X)_": "_$G(^(X,"TEXT",1),"**"))
  1. K ^TMP("DIERR",$J),PSBRET
  1. Q
  1. FILEIT ;Updt
  1. K Z,X,PSB1,PSB2
  1. N PSBMSG,PSBAUD
  1. S (PSB1,PSB2)=""
  1. D APATCH^PSBML3
  1. D AMRR^PSBML3 ;*83
  1. D CLEAN^DILF
  1. D RESETADM^PSBUTL
  1. D UPDATE^DIE("","PSBFDA","PSBIEN","PSBMSG")
  1. I '$G(PSBMMEN) S X=+PSBIEN I $F("HR",$P(^PSB(53.79,X,0),U,9))>1 F Y=.5,.6,.7 S Z=0 F S Z=$O(^PSB(53.79,+X,Y,Z)) Q:+Z=0 S $P(^PSB(53.79,+X,Y,Z,0),U,3)=0
  1. I $D(PSBMSG("DIERR")) S RESULTS(0)=1,RESULTS(1)="-1^"_PSBMSG("DIERR",1)_": "_PSBMSG("DIERR",1,"TEXT",1) Q
  1. I $G(PSB1)]"" X PSB1 I $G(PSB2)]"" X PSB2
  1. I $G(PSB1A)]"" X PSB1A I $G(PSB2A)]"" X PSB2A ;*83
  1. I $D(PSBHDR) D:"NHMR"[$P(^PSB(53.79,$S($P(PSBHDR,"^",1)="+1":PSBIEN(1),1:+PSBIEN),0),U,9)
  1. .N PSBINDX S PSBINDX=$S($P(PSBHDR,"^",1)="+1":PSBIEN(1),1:+PSBIEN)
  1. .K ^PSB(53.79,"APATCH",$P(^PSB(53.79,PSBINDX,0),U),$P(^PSB(53.79,PSBINDX,0),U,6),PSBINDX)
  1. S RESULTS(0)=1,RESULTS(1)="1^Data Successfully Filed^"_$S($G(PSBIEN(1))'="":$G(PSBIEN(1)),1:+$G(PSBIEN))
  1. D BCBU ;NatContng
  1. D ;
  1. . N X,DIC
  1. . S X="PSB EVSEND VPR",DIC=101 D EN^XQOR ;should handle all BCMA Med Log events for VPR
  1. I $G(PSBINST,0) S PSBAUD=$S($P(PSBHDR,"^",1)="+1":PSBIEN(1),1:$P(PSBHDR,"^",1)) D AUDIT^PSBMLU(PSBAUD,"Instructor "_PSBINST(0)_" present.",PSBTRAN)
  1. K PSB1,PSB2,PSB1A,PSB2A ;*83
  1. Q
  1. ERR(X,Y) ;
  1. S X=$P("Business Logic Error^Data Validation Error",U,X)
  1. S RESULTS($O(RESULTS(""),-1)+1)=X_": "_Y
  1. S PSBMES($O(PSBMES(""),-1)+1)=X_": "_Y
  1. Q
  1. COMMENT(DA,PSBCMT) ;
  1. N PSBFDA,PSBIEN,PSBNOW
  1. S PSBIEN="+1,"_DA_","
  1. D NOW^%DTC S PSBNOW=%
  1. D VAL(53.793,PSBIEN,.01,PSBCMT)
  1. S PSBFDA(53.793,PSBIEN,.02)=DUZ
  1. S PSBFDA(53.793,PSBIEN,.03)=PSBNOW
  1. D FILEIT
  1. Q