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 ;03/06/16 3:06pm
  1. ;;3.0;BAR CODE MED ADMIN;**6,3,12,11,13,32,25,61,70,83,114**;Mar 2004;Build 3
  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. ;*70 - Clinic Orders will use an Admin Early/Late calc of any day
  1. ; before or After TODAY instead of minutes as in IM meds.
  1. ;*83 - Add ability to do Remove Early/Late tests on Sched Remove time
  1. ; -add a 10 param, sched remove time
  1. ; -add check for meds not removed for other orders (by OI)
  1. ;
  1. EN(RESULTS,DFN,PSBXOR,PSBTYPE,PSBADMIN,PSBTAB,PSBUID,PSBASTS,PSBORSTS,PSBRMV,PSBRMT) ;
  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,FOUND,LSTACTN,PSBLSTGV,PSBLADT,PSBLAIEN,X,CLORD ;*83
  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 CLORD=$S($G(PSBCLORD)]"":1,1:0) ;if a Clinc ord, 1 else 0 *83
  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. ;
  1. ;patch/MRR removal does not follow The Rest of validation rules
  1. ; special tests for RM added *83
  1. I ((PSBTAB="UDTAB")!(PSBTAB="PBTAB")),((PSBRMV="RM")!(PSBRMV="N")) D Q
  1. .D:PSBRMV="N"
  1. ..S PSB=PSB+1,RESULTS(0)=PSB
  1. ..S RESULTS(PSB)="0^Okay to Undo"
  1. .I PSBASTS="" Q ;status is not given - don't check for mismatch
  1. .;check for admin status mismatch
  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 D Q ;Quit if -2 err, dont fall thru to RM logic
  1. ..S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-2^Admin status mismatch"
  1. .;
  1. .; RM logic quits after it runs and does not fall thru
  1. .;IM order Remove, Do variance check *83
  1. .I PSBRMV="RM",'CLORD D Q
  1. ..S PSBOKAY=$$VARIANCE(PSBRMV,PSBRMT)
  1. ..S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)=PSBOKAY
  1. .;
  1. .;CO order Remove, No variance check *83
  1. .I PSBRMV="RM",CLORD D Q
  1. ..S RESULTS(0)=1,RESULTS(1)="0^Okay to Remove"
  1. ;
  1. ; The Rest of the validation rules
  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. ;
  1. ;test for non-one time orders admin prior to start date of order
  1. ;
  1. ;CO orders, check if start order date is > today
  1. I CLORD,PSBSCHT'="O"&($P(PSBOST,".")>DT) S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-1^Order Not Active" Q ;CO > today *83
  1. ;IM orders, check start order date/time > Now
  1. I 'CLORD,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 ;IM > now *83
  1. ;All orders, check stop order date/time > Now
  1. I (%>PSBOSP) S PSB=PSB+1,RESULTS(0)=PSB,RESULTS(PSB)="-1^Order Not Active, expired" Q
  1. ;
  1. ;tests sched types of continuous or prns that are MRRs
  1. I (PSBSCHT="C")!((PSBSCHT="P")&(PSBMRRFL>0)) 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. .;set special action flag
  1. .S PSBFLAG=0 I PSBRMV="M"!(PSBRMV="H")!(PSBRMV="R") S PSBFLAG=1
  1. .;
  1. .;*** Check for errors vs. last valid completed action this order.
  1. .; completed = Given or Removed, end of a UD admin life cycle
  1. .I $D(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE)) D Q:X
  1. ..S X=0,LSTACTN="",PSBLAIEN=0
  1. ..S PSBLADT="",FOUND=0
  1. ..F S PSBLADT=$O(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE,PSBLADT),-1) Q:'PSBLADT D Q:FOUND
  1. ...S PSBLAIEN=$O(^PSB(53.79,"AORDX",DFN,PSBXOR_PSBTYPE,PSBLADT,""),-1)
  1. ...S LSTACTN=$P($G(^PSB(53.79,PSBLAIEN,0)),U,9)
  1. ...I (LSTACTN="G")!(LSTACTN="RM") S FOUND=1 ;found a previous G/RM
  1. ..Q:'FOUND ;quit, no last valid completed type last action found
  1. ..;
  1. ..;MRR - Previous Admin NOT REMOVED tests
  1. ..I LSTACTN="G",PSBFLAG=0 D
  1. ...N DSPDRG S DSPDRG=$O(^PSB(53.79,PSBLAIEN,.5,0)) I 'DSPDRG Q
  1. ...I $P($G(^PSB(53.79,PSBLAIEN,.5,DSPDRG,0)),U,4)="PATCH" D NOTREMVD
  1. ...I 'X,$P($G(^PSB(53.79,PSBLAIEN,.5,DSPDRG,0)),U,6)>0 D NOTREMVD
  1. ..;
  1. ..;if trying to Give an earlier dose after a later admin Given *83
  1. ..S PSBLSTGV=$P(^PSB(53.79,PSBLAIEN,.1),U,3)
  1. ..I PSBADMIN<PSBLSTGV,PSBFLAG=0 D
  1. ...S X=1
  1. ...S PSBOKAY="-1^A later dose scheduled at ("_$$FMTE^XLFDT(PSBLSTGV,2)_") was given "_($$FMDIFF^XLFDT($$NOW^XLFDT,$P(^PSB(53.79,PSBLAIEN,0),U,6),2)\60)_" minutes ago."
  1. .;****
  1. .;
  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. .;*70 perform early/late admin testing for IM & CO orders
  1. .;
  1. .;*83 call tag for non-removal actions - IM orders only
  1. .I 'CLORD,PSBRMV'="RM",'PSBFLAG S PSBOKAY=$$VARIANCE(PSBRMV,PSBADMIN)
  1. .;
  1. .D:CLORD ;CO order new logic
  1. ..N ADMINDT S ADMINDT=$P(PSBADMIN,".")
  1. ..S PSBOKAY="1^You are about to give a medication that "
  1. ..I ADMINDT>DT D Q
  1. ...S PSBOKAY=PSBOKAY_"is scheduled for "_$$DOW^XLFDT(ADMINDT)_", "_$$FMTE^XLFDT(ADMINDT,5)_"."
  1. ..I ADMINDT<DT D Q
  1. ...S PSBOKAY=PSBOKAY_"was scheduled for "_$$DOW^XLFDT(ADMINDT)_", "_$$FMTE^XLFDT(ADMINDT,5)_"."
  1. ..S PSBOKAY="0^Okay to administer"
  1. .;*70 end early/late logic
  1. ;
  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. .I (+($G(PSBOKAY))<0)&(PSBMRRFL>0) Q ;MRR may need removal *83
  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) S:PSBUNIT>0&(PSBUNIT<1) PSBUNIT="0"_+PSBUNIT ;Add leading 0 for decimal values less than 1, PSB*3*61
  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. ;
  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. ;
  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. .S X=0
  1. .I PSBGVN,$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL") D Q:X
  1. ..I PSBDOSEF="PATCH" D NOTREMVD Q ;*83
  1. ..I PSBMRRFL>0 D NOTREMVD Q ;*83
  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 into 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. ..;remove "RM" sts previous action test for this warning *83
  1. ..I (PSBSTUS="G")!(PSBSTUS="H")!(PSBSTUS="R") 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. .;check for same OI medication MRR not removed, warning *83
  1. .N LST
  1. .I PSBMRRFL,$$OIREMVD(DFN,PSBOIT,.LST) D
  1. ..;find last ien in psbokay, so won't overwrite with new OI msgs *83
  1. ..N Q S Q=$O(PSBOKAY(""),-1)
  1. ..F X=0:0 S X=$O(LST(X)) Q:'X D
  1. ...S PSBOKAY(Q+X)="1^Medication "_$P(LST(X),U,2)_" for scheduled administration "_$P(LST(X),U)_" has NOT been removed. "
  1. ;
  1. ;adds fall thru err msg text to Results
  1. S PSB=PSB+1,RESULTS(PSB)=PSBOKAY
  1. ;
  1. ;overwrite 0^okay text with 1^warning text IF array PSBOKAY populated
  1. I RESULTS(1)["0^Okay",$D(PSBOKAY)>9 S PSB=0
  1. F X=0:0 S X=$O(PSBOKAY(X)) Q:'X D
  1. .S PSB=PSB+1,RESULTS(PSB)=PSBOKAY(X)
  1. ;
  1. S RESULTS(0)=$O(RESULTS(999),-1) ;set to always agree to content
  1. Q
  1. ;
  1. NOTREMVD ;Standard "Not Removed" MRR error msg & special pre-warning test *83
  1. S PSBOKAY=""
  1. I PSBRMV'="RM" S PSBOKAY=$$VARIANCE(PSBRMV,PSBADMIN)
  1. ;check special case of Early Admin - move Early error msg to Results
  1. ;array so PSBOKAY can be reused for later dual -1 errmsg: early admin
  1. ;
  1. I PSBOKAY["Admin",PSBOKAY["before" D
  1. .S PSB=PSB+1,RESULTS(PSB)=PSBOKAY,RESULTS(0)=PSB
  1. S X=1
  1. S PSBOKAY="-1^Cannot Give medication until previous administration has been removed."
  1. Q
  1. ;
  1. VARIANCE(ACTION,DATETM) ;check for variance to exceed Early/Late window *83
  1. N MSG
  1. S PSBWIN1=$$GET^XPAR("DIV","PSB ADMIN BEFORE")*-1 ;Minutes before
  1. S PSBWIN2=$$GET^XPAR("DIV","PSB ADMIN AFTER") ;Minutes After
  1. D NOW^%DTC
  1. S PSBMIN=$S($P(DATETM,".",2):$$DIFF^PSBUTL(DATETM,%),1:0)
  1. ;
  1. D:ACTION'="RM" ;Not a Removal
  1. .I PSBMIN<PSBWIN1 S MSG="1^Admin is "_(PSBMIN*-1)_" minutes before the scheduled administration time" Q
  1. .I PSBMIN>PSBWIN2 S MSG="1^Admin is "_(PSBMIN)_" minutes after the scheduled administration time" Q
  1. .S MSG="0^Okay to "_$S(ACTION="H":"Hold",ACTION="R":"Refuse",1:"administer")
  1. ;
  1. D:ACTION="RM" ;Removal: use a new code #5 for RED txt (Early RM)
  1. .S MSG="0^Okay to Remove"
  1. .I PSBMIN<PSBWIN1 S MSG="5^Removal is "_(PSBMIN*-1)_" minutes before the scheduled removal time" Q
  1. .I PSBMIN>PSBWIN2 S MSG="1^Removal is "_(PSBMIN)_" minutes after the scheduled removal time" Q
  1. ;
  1. Q MSG
  1. ;
  1. OIREMVD(DFN,OI,REM) ;Is another OI MRR not removed?
  1. ; Input:
  1. ; DFN = patient ien
  1. ; OI = Ordreable Item Ien
  1. ;Output:
  1. ; Function - false/true
  1. ; parm- REM(ien), IEN of file 53.79 array of meds needing Removal
  1. ; formatted: Sched Admin date/time ^ Disp drug name ^Ordno
  1. ; if One time sched, then set Sched Admin = actual given date/time
  1. ;
  1. ;check for previous MRR type 1 med not removed *83
  1. N CNT,PSBBK,DTE,IEN,QQ,MEDNM,ORDNO,SCHADM
  1. S PSBBK=$$GET^XPAR("DIV","PSB VDL PATCH DAYS")
  1. S PSBBK=$$FMADD^XLFDT(DT,-$S(PSBBK>0:PSBBK,1:30))
  1. S DTE="",CNT=0
  1. F S DTE=$O(^PSB(53.79,"AOIP",DFN,OI,DTE),-1) Q:('DTE)!((DTE\1)<PSBBK) D
  1. .S IEN=""
  1. .F S IEN=$O(^PSB(53.79,"AOIP",DFN,OI,DTE,IEN),-1) Q:'IEN D
  1. ..Q:$P($G(^PSB(53.79,IEN,0)),U,9)'="G"
  1. ..S CNT=CNT+1
  1. ..S SCHADM=$$GET1^DIQ(53.79,+IEN,"SCHEDULED ADMINISTRATION TIME")
  1. ..S:'SCHADM SCHADM=$E($$GET1^DIQ(53.79,+IEN,"ACTION DATE/TIME"),1,18)
  1. ..S QQ=$O(^PSB(53.79,IEN,.5,0))
  1. ..S:QQ MEDNM=$$GET1^DIQ(53.795,QQ_","_IEN,"DISPENSE DRUG")
  1. ..S ORDNO=$$GET1^DIQ(53.79,+IEN,"ORDER REFERENCE NUMBER")
  1. ..S REM(CNT)=SCHADM_U_MEDNM_U_ORDNO
  1. Q $D(REM)