- 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 Jan 18, 2025@02:41:23 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 ;