PSBMLEN ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**4,9,19,75,83,114**;Mar 2004;Build 3
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA/2828
; ENE^PSJBCMA4/3416
; ENR^PSJBCMA4/3416
; ^XUSEC/10076
; ^DPT/10035
; $$GET^XPAR/2263
; HLP^DDSUTL/10150
;
;*83 - For MRR meds get remove string and print in 4 digit format.
; Always print admin string in 4 digit format for all meds
EN ;
N PSBCNT,PSBDT,PSBERR,PSBFORM,PSBMED,PSBNOW,PSBSCHT,PSBVARD,PSBX,PSBFREQ,PSBFLAG
K ^TMP("PSB",$J),^TMP("PSJ",$J),PSBREC
W @IOF,!,"Manual Medication Entry",!
I $D(^XUSEC("PSB READ ONLY",DUZ)) W !,"This option is NOT AVAILABLE in PSB READ ONLY mode.",! Q
W !,"Notice: No validation of medications is done with this option."
W !,"Entries in the Med Log created with this option will reflect this"
W !,"in the comments.",!!
S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: "
D ^DIC K DIC Q:+Y<1
S DFN=+Y
D EN1
K ^TMP("PSBO",$J)
Q
;
EN1 ;
S %DT="AEQ",%DT("B")="Today",%DT("A")="Select Orders From Date: "
D ^%DT Q:+Y<1 S PSBDT=+Y
W !,"Searching for Orders..."
K ^TMP("PSJ",$J)
D EN^PSJBCMA(DFN,PSBDT,"")
Q:$G(^TMP("PSJ",$J,1,0))=-1
S PSBERR=0
D NOW^%DTC S PSBNOW=%
F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
.D CLEAN^PSBVT,PSJ^PSBVT(PSBX)
.Q:PSBONX?.N1"P" ; No Pending Yet
.I "PCS"'[PSBIVT,PSBONX'["U" Q
.I PSBIVT["S",PSBISYR'=1 Q ; allow intermittent syringe only
.I PSBIVT["C",PSBCHEMT'="P",PSBISYR'=1 Q
.I PSBIVT["C",PSBCHEMT="A" Q ; allow Chemo with intermittent syringe or Piggyback type only
.K ^TMP("PSBO",$J)
.S PSBOUT=0
.D:PSBSCHT="C"
..;Calculate admin times based on Frequency from IPM
..S (PSBYES,PSBODD)=0
..S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
..I PSBYES,PSBADST="" S PSBOUT=1 Q
..I PSBSCH?2.4N.E S PSBYES=1
..S PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
..I PSBFREQ="O" S PSBYES=1
..I 'PSBYES,PSBADST="",PSBFREQ<1 S PSBOUT=1 Q
..I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
..I PSBODD,PSBADST'="" S PSBOUT=1 Q
..I PSBADST="" S PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBADST
..F PSBY=1:1 Q:$P(PSBADST,"-",PSBY)="" I ($P(PSBADST,"-",PSBY)'?2N)&($P(PSBADST,"-",PSBY)'?4N) S PSBOUT=1 Q ; Validate time(s)
.Q:PSBOUT
.Q:PSBOST>PSBNOW ; Future Start Date
.I PSBSCHT="O" S (PSBGVN,X,Y)="" D I (PSBGVN)!(PSBNGF) K PSBGVN,X,Y Q
..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
.I PSBSCHT="OC" S (PSBGVN,X,Y)="" D I PSBGVN K PSBGVN,X,Y Q
..F S X=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1) Q:'X D
...F S Y=$O(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1) Q:'Y S:($P(^PSB(53.79,Y,.1),U)=PSBONX)&($P(^PSB(53.79,Y,0),U,9)'="N") PSBGVN=1,(X,Y)=0
..S PSBGVN=PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL")) Q:PSBGVN
..I PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O") S PSBGVN=1 Q ;Add On Call pharmacy status, PSB*3*75
..I PSBNGF S PSBGVN=1 Q
.S ^TMP("PSB",$J,PSBSCHT,PSBOITX,PSBX)=PSBONX_U_PSBADST_U_PSBOST_U_PSBOSP_U_PSBOSTS_U_PSBRMST_U_PSBDOA_U_PSBMRRFL_U_PSBOPRSP ;*83
I PSBERR W ! K DIR S DIR(0)="E" D ^DIR Q:Y="^"
;
EN2 ;
W $$HDR() I '$D(^TMP("PSB",$J)) W !!?5,"No Med Orders Found!",! Q
S PSBSCHT="",PSBCNT=0
F S PSBSCHT=$O(^TMP("PSB",$J,PSBSCHT)) Q:PSBSCHT="" D
.W ! ; Line between order types
.S PSBMED=""
.F S PSBMED=$O(^TMP("PSB",$J,PSBSCHT,PSBMED)) Q:PSBMED="" D
..F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX)) Q:'PSBX D
...I $Y>(IOSL-6) W ! K DIR S DIR(0)="E" D ^DIR W:Y $$HDR() I 'Y S PSBSCHT="Z" Q
...S PSBCNT=PSBCNT+1
...W !,$J(PSBCNT,2),". ",PSBSCHT,?7,PSBMED
...W ?40," (",$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,5),")"
...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,3)
...W:$X>44 !
...W ?45,"Start: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
...W $E($P(Y,".",2)_"0000",1,4)
...S Y=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,4)
...W !?45," Stop: ",$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))_" "
...W $E($P(Y,".",2)_"0000",1,4)
...;write adim times in 4 digit format *83
...I $P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)]"" W !?7,"Admin Times: ",$$CNVRT4^PSBUTL($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2),"-")
...;print 4 digit format Remove string for MRR's *83
...I ($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2)]"")!(PSBSCHT="O") D
....Q:'$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,8) ;not MRR *83
....W !?7,"Removal Times: ",$$REMSTR^PSBUTL($P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,2),$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,7),PSBSCHT,$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,4),$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,9)) ;*83
...W !
...S ^TMP("PSBO",$J,PSBCNT)=$P(^TMP("PSB",$J,PSBSCHT,PSBMED,PSBX),U,1)
F Q:$Y>(IOSL-4) W !
K DIR S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
I Y S Y=^TMP("PSBO",$J,Y) D NEW^PSBMLEN1(Y) G EN2
D CLEAN^PSBVT ;*83
Q
;
;
HDR() ;
W @IOF,"Manual Medication Entry",!," #",?4,"Sc",?7,"Medication",?41,"St"
W !,$TR($J("",IOM)," ","-")
Q ""
;
EDIT ; Edit Medication Log
N PSBAUDIT,PSBXUIT,ONX ;*83
S PSBAUDIT=1,PSBXUIT="" ;*83
W:'$D(^XUSEC("PSB MANAGER",DUZ)) !!?5,"Notice: You are restricted from editing any entries other than",!," those that you have created.",!
S DA=""
S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient Name: "
D ^DIC K DIC Q:+Y<1
S DFN=+Y
D EDIT1
K PSBCNT,PSBDT,PSBIEN,PSBSRCH,PSBTMP,DA,DFN,DR,DDSFILE
D CLEAN^PSBVT ;*83
G EDIT
;
EDIT1 ;
S %DT="AEQ",%DT("A")="Select Date to Begin Searching Back From: "
W !! S %DT("B")="TODAY" D ^%DT Q:+Y<1 S PSBDT=Y
F D Q:'PSBDT
.W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
.W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
.W !,$TR($J("",IOM)," ","-")
.S PSBSRCH=PSBDT+.9,PSBCNT=0
.K PSBTMP
.F S PSBSRCH=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH),-1) Q:'PSBSRCH!(PSBSRCH<PSBDT) D
..S PSBIEN=""
..F S PSBIEN=$O(^PSB(53.79,"AEDT",DFN,PSBSRCH,PSBIEN),-1) Q:'PSBIEN D:$P(^PSB(53.79,PSBIEN,0),U,7)=DUZ!($D(^XUSEC("PSB MANAGER",DUZ)))
...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
...S PSBCNT=PSBCNT+1,PSBTMP(PSBCNT)=PSBIEN
...D:$Y>19
....W ! S DIR(0)="E" D ^DIR
....W @IOF,!,"Searching Date " S Y=PSBDT D D^DIQ W Y
....W !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
....W !,$TR($J("",IOM)," ","-")
...W !,$J(PSBCNT,2),". "
...W ?5,$$GET1^DIQ(53.79,PSBIEN_",",.08)
...I $$GET1^DIQ(53.79,PSBIEN_",",.26) W ?5," ("_$$GET1^DIQ(53.79,PSBIEN_",",.26)_")"
...W ?45,$P(^PSB(53.79,PSBIEN,0),U,9)
...W ?50,$$GET1^DIQ(53.79,PSBIEN_",",.06)
...W ?75,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
.I PSBCNT D Q:Y
..W ! S DIR(0)="NO^1:"_PSBCNT_":0" D ^DIR
..I Y S DA=PSBTMP(Y),PSBDT=""
.I 'PSBCNT W !!?5,"No Meds Found!"
.S X1=PSBDT,X2=-1 D C^%DTC S (PSBDT,Y)=X D D^DIQ
.W !!,"Continue With ",Y
.S %=1 D YN^DICN I %'=1 S PSBDT=0
I DA D
.S PSBCOMP="",PSBDFN=$$GET1^DIQ(53.79,DA_",",.01,"I"),PSBONX=$$GET1^DIQ(53.79,DA_",",.11),PSBSTUS=$$GET1^DIQ(53.79,DA_",",.09,"I")
.I PSBONX["V",PSBSTUS'="G" D Q:PSBCOMP=1
..S PSBBAGN=$$GET1^DIQ(53.79,DA_",",.26) D INFUSING^PSBVDLU2 Q:PSBCOMP=0
..I $D(PSBPORA(PSBONX)) S X="" F S X=$O(PSBPORA(PSBONX,X)),PSBBAG2=$P(PSBPORA(PSBONX,X),U,1),PSBBAGST=$P(PSBPORA(PSBONX,X),U,2) Q:PSBBAG2]""
..I PSBBAGN=PSBBAG2 S PSBCOMP=0 Q
..I (PSBBAGN'=PSBBAG2),PSBBAGST'="C" D
...W !!,"Bag "_PSBBAG2_" is marked as ",$S(PSBBAGST="I":"Infusing",PSBBAGST="S":"Stopped",1:"unk")
...W !,"This bag must be completed before bag "_PSBBAGN_" can be edited.",!!
...K PSBORA,PSBBAGN,PSBBAG2,PSBBAGST
.I PSBONX["V" D PSJ1^PSBVT(PSBDFN,PSBONX)
.I PSBONX["U" S ONX=PSBONX ;*83
.S DDSFILE=53.79 D
..I PSBONX["U" S DR="[PSB MED LOG EDIT]" Q
..I PSBIVT["P" S DR="[PSB MED LOG EDIT]" Q
..I PSBIVT["S",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
..I PSBIVT["C",PSBISYR=1 S DR="[PSB MED LOG EDIT]" Q
..I PSBIVT["C",PSBCHEMT="P" S DR="[PSB MED LOG EDIT]" Q
..S DR="[PSB MED LOG EDIT IV]" Q
.;New Site Chk *83
.F D Q:'PSBXUIT ;*83
..S PSBXUIT=""
..D ^DDS
..D PSJ1^PSBVT(DFN,ONX)
..D SITECHK^PSBMLEN1 I PSBXUIT W !,$C(7) K DIR S DIR(0)="E" D ^DIR
.;
.;One time order reinstated if not given
.D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="N") ENR^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
.D:($P(^PSB(53.79,DA,.1),U,2)="O")&($P(^PSB(53.79,DA,0),U,9)="G") ENE^PSJBCMA4(DFN,$P(^PSB(53.79,DA,.1),U,1))
Q
;
VALID ;
I $G(PSBSTUS)="RM","^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Status of Removed cannot be changed.") Q
I $G(PSBREC(7))'="Entry created with 'Manual Medication Entry' option." D Q
.N DSPDRG S DSPDRG=$O(^PSB(53.79,DA,.5,0)) I 'DSPDRG Q
.I ($D(^PSB(53.79,DA,.5,DSPDRG,0))),($P($G(^PSB(53.79,DA,.5,DSPDRG,0)),U,4)="PATCH") D Q
..I "^G^N^H^R^RM^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, Refused and Removed.")
.I "^G^N^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, and Refused.")
I "^G^H^R^"'[("^"_X_"^") W $C(7) S DDSERROR=1 D HLP^DDSUTL("Allowed status codes are Given, Held, and Refused.") Q
;
UNITS ;Check UNITS field for entry of PATCH
I Y'="PATCH" Q
S (DDSERROR,DDSBR)=1
S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
W $C(7)
D HLP^DDSUTL("Field cannot be changed to PATCH")
D REFRESH^DDSUTL
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBMLEN 9944 printed Dec 13, 2024@01:40:09 Page 2
PSBMLEN ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**4,9,19,75,83,114**;Mar 2004;Build 3
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; EN^PSJBCMA/2828
+6 ; ENE^PSJBCMA4/3416
+7 ; ENR^PSJBCMA4/3416
+8 ; ^XUSEC/10076
+9 ; ^DPT/10035
+10 ; $$GET^XPAR/2263
+11 ; HLP^DDSUTL/10150
+12 ;
+13 ;*83 - For MRR meds get remove string and print in 4 digit format.
+14 ; Always print admin string in 4 digit format for all meds
EN ;
+1 NEW PSBCNT,PSBDT,PSBERR,PSBFORM,PSBMED,PSBNOW,PSBSCHT,PSBVARD,PSBX,PSBFREQ,PSBFLAG
+2 KILL ^TMP("PSB",$JOB),^TMP("PSJ",$JOB),PSBREC
+3 WRITE @IOF,!,"Manual Medication Entry",!
+4 IF $DATA(^XUSEC("PSB READ ONLY",DUZ))
WRITE !,"This option is NOT AVAILABLE in PSB READ ONLY mode.",!
QUIT
+5 WRITE !,"Notice: No validation of medications is done with this option."
+6 WRITE !,"Entries in the Med Log created with this option will reflect this"
+7 WRITE !,"in the comments.",!!
+8 SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Select PATIENT: "
+9 DO ^DIC
KILL DIC
if +Y<1
QUIT
+10 SET DFN=+Y
+11 DO EN1
+12 KILL ^TMP("PSBO",$JOB)
+13 QUIT
+14 ;
EN1 ;
+1 SET %DT="AEQ"
SET %DT("B")="Today"
SET %DT("A")="Select Orders From Date: "
+2 DO ^%DT
if +Y<1
QUIT
SET PSBDT=+Y
+3 WRITE !,"Searching for Orders..."
+4 KILL ^TMP("PSJ",$JOB)
+5 DO EN^PSJBCMA(DFN,PSBDT,"")
+6 if $GET(^TMP("PSJ",$JOB,1,0))=-1
QUIT
+7 SET PSBERR=0
+8 DO NOW^%DTC
SET PSBNOW=%
+9 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSJ",$JOB,PSBX))
if 'PSBX
QUIT
Begin DoDot:1
+10 DO CLEAN^PSBVT
DO PSJ^PSBVT(PSBX)
+11 ; No Pending Yet
if PSBONX?.N1"P"
QUIT
+12 IF "PCS"'[PSBIVT
IF PSBONX'["U"
QUIT
+13 ; allow intermittent syringe only
IF PSBIVT["S"
IF PSBISYR'=1
QUIT
+14 IF PSBIVT["C"
IF PSBCHEMT'="P"
IF PSBISYR'=1
QUIT
+15 ; allow Chemo with intermittent syringe or Piggyback type only
IF PSBIVT["C"
IF PSBCHEMT="A"
QUIT
+16 KILL ^TMP("PSBO",$JOB)
+17 SET PSBOUT=0
+18 if PSBSCHT="C"
Begin DoDot:2
+19 ;Calculate admin times based on Frequency from IPM
+20 SET (PSBYES,PSBODD)=0
+21 if $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBYES=1
+22 IF PSBYES
IF PSBADST=""
SET PSBOUT=1
QUIT
+23 IF PSBSCH?2.4N.E
SET PSBYES=1
+24 SET PSBFREQ=$$GETFREQ^PSBVDLU1(DFN,PSBONX)
+25 IF PSBFREQ="O"
SET PSBYES=1
+26 IF 'PSBYES
IF PSBADST=""
IF PSBFREQ<1
SET PSBOUT=1
QUIT
+27 IF (PSBFREQ#1440'=0)
IF (1440#PSBFREQ'=0)
SET PSBODD=1
+28 IF PSBODD
IF PSBADST'=""
SET PSBOUT=1
QUIT
+29 IF PSBADST=""
SET PSBADST=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBDT)
+30 IF '$TEST
KILL ^TMP("PSB",$JOB,"GETADMIN")
SET ^TMP("PSB",$JOB,"GETADMIN",0)=PSBADST
+31 ; Validate time(s)
FOR PSBY=1:1
if $PIECE(PSBADST,"-",PSBY)=""
QUIT
IF ($PIECE(PSBADST,"-",PSBY)'?2N)&($PIECE(PSBADST,"-",PSBY)'?4N)
SET PSBOUT=1
QUIT
End DoDot:2
+32 if PSBOUT
QUIT
+33 ; Future Start Date
if PSBOST>PSBNOW
QUIT
+34 IF PSBSCHT="O"
SET (PSBGVN,X,Y)=""
Begin DoDot:2
+35 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+36 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
if ($PIECE(^PSB(53.79,Y,.1),U)=PSBONX)&($PIECE(^PSB(53.79,Y,0),U,9)'="N")
SET PSBGVN=1
SET (X,Y)=0
End DoDot:3
End DoDot:2
IF (PSBGVN)!(PSBNGF)
KILL PSBGVN,X,Y
QUIT
+37 IF PSBSCHT="OC"
SET (PSBGVN,X,Y)=""
Begin DoDot:2
+38 FOR
SET X=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X),-1)
if 'X
QUIT
Begin DoDot:3
+39 FOR
SET Y=$ORDER(^PSB(53.79,"AOIP",DFN,PSBOIT,X,Y),-1)
if 'Y
QUIT
if ($PIECE(^PSB(53.79,Y,.1),U)=PSBONX)&($PIECE(^PSB(53.79,Y,0),U,9)'="N")
SET PSBGVN=1
SET (X,Y)=0
End DoDot:3
+40 SET PSBGVN=PSBGVN&('$$GET^XPAR("DIV","PSB ADMIN MULTIPLE ONCALL"))
if PSBGVN
QUIT
+41 ;Add On Call pharmacy status, PSB*3*75
IF PSBOSTS'="A"&(PSBOSTS'="R")&(PSBOSTS'="O")
SET PSBGVN=1
QUIT
+42 IF PSBNGF
SET PSBGVN=1
QUIT
End DoDot:2
IF PSBGVN
KILL PSBGVN,X,Y
QUIT
+43 ;*83
SET ^TMP("PSB",$JOB,PSBSCHT,PSBOITX,PSBX)=PSBONX_U_PSBADST_U_PSBOST_U_PSBOSP_U_PSBOSTS_U_PSBRMST_U_PSBDOA_U_PSBMRRFL_U_PSBOPRSP
End DoDot:1
+44 IF PSBERR
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
if Y="^"
QUIT
+45 ;
EN2 ;
+1 WRITE $$HDR()
IF '$DATA(^TMP("PSB",$JOB))
WRITE !!?5,"No Med Orders Found!",!
QUIT
+2 SET PSBSCHT=""
SET PSBCNT=0
+3 FOR
SET PSBSCHT=$ORDER(^TMP("PSB",$JOB,PSBSCHT))
if PSBSCHT=""
QUIT
Begin DoDot:1
+4 ; Line between order types
WRITE !
+5 SET PSBMED=""
+6 FOR
SET PSBMED=$ORDER(^TMP("PSB",$JOB,PSBSCHT,PSBMED))
if PSBMED=""
QUIT
Begin DoDot:2
+7 FOR PSBX=0:0
SET PSBX=$ORDER(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX))
if 'PSBX
QUIT
Begin DoDot:3
+8 IF $Y>(IOSL-6)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
if Y
WRITE $$HDR()
IF 'Y
SET PSBSCHT="Z"
QUIT
+9 SET PSBCNT=PSBCNT+1
+10 WRITE !,$JUSTIFY(PSBCNT,2),". ",PSBSCHT,?7,PSBMED
+11 WRITE ?40," (",$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,5),")"
+12 SET Y=$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,3)
+13 if $X>44
WRITE !
+14 WRITE ?45,"Start: ",$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_(1700+$EXTRACT(Y,1,3))_" "
+15 WRITE $EXTRACT($PIECE(Y,".",2)_"0000",1,4)
+16 SET Y=$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,4)
+17 WRITE !?45," Stop: ",$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_(1700+$EXTRACT(Y,1,3))_" "
+18 WRITE $EXTRACT($PIECE(Y,".",2)_"0000",1,4)
+19 ;write adim times in 4 digit format *83
+20 IF $PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,2)]""
WRITE !?7,"Admin Times: ",$$CNVRT4^PSBUTL($PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,2),"-")
+21 ;print 4 digit format Remove string for MRR's *83
+22 IF ($PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,2)]"")!(PSBSCHT="O")
Begin DoDot:4
+23 ;not MRR *83
if '$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,8)
QUIT
+24 ;*83
WRITE !?7,"Removal Times: ",$$REMSTR^PSBUTL($PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,2),$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,7),PSBSCHT,$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,4),$PIECE(^TMP("
PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,9))
End DoDot:4
+25 WRITE !
+26 SET ^TMP("PSBO",$JOB,PSBCNT)=$PIECE(^TMP("PSB",$JOB,PSBSCHT,PSBMED,PSBX),U,1)
End DoDot:3
End DoDot:2
End DoDot:1
+27 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+28 KILL DIR
SET DIR(0)="NO^1:"_PSBCNT_":0"
DO ^DIR
+29 IF Y
SET Y=^TMP("PSBO",$JOB,Y)
DO NEW^PSBMLEN1(Y)
GOTO EN2
+30 ;*83
DO CLEAN^PSBVT
+31 QUIT
+32 ;
+33 ;
HDR() ;
+1 WRITE @IOF,"Manual Medication Entry",!," #",?4,"Sc",?7,"Medication",?41,"St"
+2 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+3 QUIT ""
+4 ;
EDIT ; Edit Medication Log
+1 ;*83
NEW PSBAUDIT,PSBXUIT,ONX
+2 ;*83
SET PSBAUDIT=1
SET PSBXUIT=""
+3 if '$DATA(^XUSEC("PSB MANAGER",DUZ))
WRITE !!?5,"Notice: You are restricted from editing any entries other than",!," those that you have created.",!
+4 SET DA=""
+5 SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Select Patient Name: "
+6 DO ^DIC
KILL DIC
if +Y<1
QUIT
+7 SET DFN=+Y
+8 DO EDIT1
+9 KILL PSBCNT,PSBDT,PSBIEN,PSBSRCH,PSBTMP,DA,DFN,DR,DDSFILE
+10 ;*83
DO CLEAN^PSBVT
+11 GOTO EDIT
+12 ;
EDIT1 ;
+1 SET %DT="AEQ"
SET %DT("A")="Select Date to Begin Searching Back From: "
+2 WRITE !!
SET %DT("B")="TODAY"
DO ^%DT
if +Y<1
QUIT
SET PSBDT=Y
+3 FOR
Begin DoDot:1
+4 WRITE @IOF,!,"Searching Date "
SET Y=PSBDT
DO D^DIQ
WRITE Y
+5 WRITE !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
+6 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
+7 SET PSBSRCH=PSBDT+.9
SET PSBCNT=0
+8 KILL PSBTMP
+9 FOR
SET PSBSRCH=$ORDER(^PSB(53.79,"AEDT",DFN,PSBSRCH),-1)
if 'PSBSRCH!(PSBSRCH<PSBDT)
QUIT
Begin DoDot:2
+10 SET PSBIEN=""
+11 FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AEDT",DFN,PSBSRCH,PSBIEN),-1)
if 'PSBIEN
QUIT
if $PIECE(^PSB(53.79,PSBIEN,0),U,7)=DUZ!($DATA(^XUSEC("PSB MANAGER",DUZ)))
Begin DoDot:3
+12 if $PIECE(^PSB(53.79,PSBIEN,0),U,9)="N"
QUIT
+13 SET PSBCNT=PSBCNT+1
SET PSBTMP(PSBCNT)=PSBIEN
+14 if $Y>19
Begin DoDot:4
+15 WRITE !
SET DIR(0)="E"
DO ^DIR
+16 WRITE @IOF,!,"Searching Date "
SET Y=PSBDT
DO D^DIQ
WRITE Y
+17 WRITE !," # Medication",?45,"St",?50,"D/T Given",?75,"Int"
+18 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-")
End DoDot:4
+19 WRITE !,$JUSTIFY(PSBCNT,2),". "
+20 WRITE ?5,$$GET1^DIQ(53.79,PSBIEN_",",.08)
+21 IF $$GET1^DIQ(53.79,PSBIEN_",",.26)
WRITE ?5," ("_$$GET1^DIQ(53.79,PSBIEN_",",.26)_")"
+22 WRITE ?45,$PIECE(^PSB(53.79,PSBIEN,0),U,9)
+23 WRITE ?50,$$GET1^DIQ(53.79,PSBIEN_",",.06)
+24 WRITE ?75,$$GET1^DIQ(53.79,PSBIEN_",","ACTION BY:INITIAL")
End DoDot:3
End DoDot:2
+25 IF PSBCNT
Begin DoDot:2
+26 WRITE !
SET DIR(0)="NO^1:"_PSBCNT_":0"
DO ^DIR
+27 IF Y
SET DA=PSBTMP(Y)
SET PSBDT=""
End DoDot:2
if Y
QUIT
+28 IF 'PSBCNT
WRITE !!?5,"No Meds Found!"
+29 SET X1=PSBDT
SET X2=-1
DO C^%DTC
SET (PSBDT,Y)=X
DO D^DIQ
+30 WRITE !!,"Continue With ",Y
+31 SET %=1
DO YN^DICN
IF %'=1
SET PSBDT=0
End DoDot:1
if 'PSBDT
QUIT
+32 IF DA
Begin DoDot:1
+33 SET PSBCOMP=""
SET PSBDFN=$$GET1^DIQ(53.79,DA_",",.01,"I")
SET PSBONX=$$GET1^DIQ(53.79,DA_",",.11)
SET PSBSTUS=$$GET1^DIQ(53.79,DA_",",.09,"I")
+34 IF PSBONX["V"
IF PSBSTUS'="G"
Begin DoDot:2
+35 SET PSBBAGN=$$GET1^DIQ(53.79,DA_",",.26)
DO INFUSING^PSBVDLU2
if PSBCOMP=0
QUIT
+36 IF $DATA(PSBPORA(PSBONX))
SET X=""
FOR
SET X=$ORDER(PSBPORA(PSBONX,X))
SET PSBBAG2=$PIECE(PSBPORA(PSBONX,X),U,1)
SET PSBBAGST=$PIECE(PSBPORA(PSBONX,X),U,2)
if PSBBAG2]""
QUIT
+37 IF PSBBAGN=PSBBAG2
SET PSBCOMP=0
QUIT
+38 IF (PSBBAGN'=PSBBAG2)
IF PSBBAGST'="C"
Begin DoDot:3
+39 WRITE !!,"Bag "_PSBBAG2_" is marked as ",$SELECT(PSBBAGST="I":"Infusing",PSBBAGST="S":"Stopped",1:"unk")
+40 WRITE !,"This bag must be completed before bag "_PSBBAGN_" can be edited.",!!
+41 KILL PSBORA,PSBBAGN,PSBBAG2,PSBBAGST
End DoDot:3
End DoDot:2
if PSBCOMP=1
QUIT
+42 IF PSBONX["V"
DO PSJ1^PSBVT(PSBDFN,PSBONX)
+43 ;*83
IF PSBONX["U"
SET ONX=PSBONX
+44 SET DDSFILE=53.79
Begin DoDot:2
+45 IF PSBONX["U"
SET DR="[PSB MED LOG EDIT]"
QUIT
+46 IF PSBIVT["P"
SET DR="[PSB MED LOG EDIT]"
QUIT
+47 IF PSBIVT["S"
IF PSBISYR=1
SET DR="[PSB MED LOG EDIT]"
QUIT
+48 IF PSBIVT["C"
IF PSBISYR=1
SET DR="[PSB MED LOG EDIT]"
QUIT
+49 IF PSBIVT["C"
IF PSBCHEMT="P"
SET DR="[PSB MED LOG EDIT]"
QUIT
+50 SET DR="[PSB MED LOG EDIT IV]"
QUIT
End DoDot:2
+51 ;New Site Chk *83
+52 ;*83
FOR
Begin DoDot:2
+53 SET PSBXUIT=""
+54 DO ^DDS
+55 DO PSJ1^PSBVT(DFN,ONX)
+56 DO SITECHK^PSBMLEN1
IF PSBXUIT
WRITE !,$CHAR(7)
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:2
if 'PSBXUIT
QUIT
+57 ;
+58 ;One time order reinstated if not given
+59 if ($PIECE(^PSB(53.79,DA,.1),U,2)="O")&($PIECE(^PSB(53.79,DA,0),U,9)="N")
DO ENR^PSJBCMA4(DFN,$PIECE(^PSB(53.79,DA,.1),U,1))
+60 if ($PIECE(^PSB(53.79,DA,.1),U,2)="O")&($PIECE(^PSB(53.79,DA,0),U,9)="G")
DO ENE^PSJBCMA4(DFN,$PIECE(^PSB(53.79,DA,.1),U,1))
End DoDot:1
+61 QUIT
+62 ;
VALID ;
+1 IF $GET(PSBSTUS)="RM"
IF "^RM^"'[("^"_X_"^")
WRITE $CHAR(7)
SET DDSERROR=1
DO HLP^DDSUTL("Status of Removed cannot be changed.")
QUIT
+2 IF $GET(PSBREC(7))'="Entry created with 'Manual Medication Entry' option."
Begin DoDot:1
+3 NEW DSPDRG
SET DSPDRG=$ORDER(^PSB(53.79,DA,.5,0))
IF 'DSPDRG
QUIT
+4 IF ($DATA(^PSB(53.79,DA,.5,DSPDRG,0)))
IF ($PIECE($GET(^PSB(53.79,DA,.5,DSPDRG,0)),U,4)="PATCH")
Begin DoDot:2
+5 IF "^G^N^H^R^RM^"'[("^"_X_"^")
WRITE $CHAR(7)
SET DDSERROR=1
DO HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, Refused and Removed.")
End DoDot:2
QUIT
+6 IF "^G^N^H^R^"'[("^"_X_"^")
WRITE $CHAR(7)
SET DDSERROR=1
DO HLP^DDSUTL("Allowed status codes are Given, Not Given, Held, and Refused.")
End DoDot:1
QUIT
+7 IF "^G^H^R^"'[("^"_X_"^")
WRITE $CHAR(7)
SET DDSERROR=1
DO HLP^DDSUTL("Allowed status codes are Given, Held, and Refused.")
QUIT
+8 ;
UNITS ;Check UNITS field for entry of PATCH
+1 IF Y'="PATCH"
QUIT
+2 SET (DDSERROR,DDSBR)=1
+3 SET @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
+4 WRITE $CHAR(7)
+5 DO HLP^DDSUTL("Field cannot be changed to PATCH")
+6 DO REFRESH^DDSUTL
+7 QUIT
+8 ;
