- PSSDSAPD ;BIR/RTR-Main Dose Check API ;09/16/08
- ;;1.0;PHARMACY DATA MANAGEMENT;**117,160,173,201,178,206**;9/30/97;Build 10
- ;
- ;Dose Check API
- ;
- ;Input
- ;PSSDBASE = Name of subscript
- ;PSSDBDFN = Patient Internal Entry Number
- ;PSSDBDS = Data to use to build actual Input data, for pieces not sent in PSSDBFDB array
- ;PSSDBFDB = Array where if the node exists, just set that data (even if null) directly into the corresponding API piece
- DOSE(PSSDBASX,PSSDBDFN,PSSDBDS,PSSDBFDB) ;
- I $G(PSSDBASX(1))="" Q
- N PSSDBASE,PSSDBASF,PSSDBASG,PSSDBASA,PSSDBASB S PSSDBASE=PSSDBASX(1),PSSDBASF=$G(PSSDBASX(2)),PSSDBASG=$G(PSSDBASX(3)) K ^TMP($J,PSSDBASE) K ^TMP($J,"PSSDOSGL") K ^TMP($J,"PSSCNX")
- S PSSDBASA=0 I $G(PSSDBASF)'="" K ^TMP($J,PSSDBASF) S PSSDBASA=1
- S PSSDBASB=0 I $G(PSSDBASG)'="" K ^TMP($J,PSSDBASG) S PSSDBASB=1
- S ^TMP($J,PSSDBASE,"IN","PING")="" D IN^PSSHRQ2(PSSDBASE)
- I $P($G(^TMP($J,PSSDBASE,"OUT",0)),"^")=-1 D DOWN^PSSDSAPK Q
- K ^TMP($J,PSSDBASE)
- N PSSDBLP,PSSDBND1,PSSDBND3,PSSDBAR,PSSDBFST,PSSDBFLG,PSSDBCOT,PSSDBCAR,PSSDBFRC,PSSDBFRB,PSSDBIFL,PSSDBIFG,PSSDBCAX,PSSDBCAZ,PSSDBFTX,PSSDBADJ,PSSDBCDP,PSSDSDPL,PSSDSWHE,PSSENHK,PSSENHKZ,PSSDSIVF,PSSENO,PSSDBSNO,PSSDLEM
- I +$G(PSSDBDFN)'>0 Q
- S (PSSDBFLG,PSSDBSNO)=0 S PSSDSWHE=$S($E($G(PSSDBASE),1,2)="OR":1,1:0) ;2.1 PSSDBSNO added - remains at 0 if all schedules are excluded from all Dosing checks, set in Comp Tag
- F PSSDBLP=0:0 S PSSDBLP=$O(PSSDBFDB(PSSDBLP)) Q:'PSSDBLP D
- .K PSSDBAR,PSSDBND1,PSSDBND3 S (PSSDBIFL,PSSDBIFG,PSSDSIVF,PSSENO)=0
- .I $G(PSSDBFDB(PSSDBLP,"RX_NUM"))="" Q
- .I $G(PSSDBFDB(PSSDBLP,"DRUG_NM"))="" Q
- .S PSSDBFDB("OI")=$S($G(PSSDBFDB(PSSDBLP,"OI")):$G(PSSDBFDB(PSSDBLP,"OI")),1:$G(PSSDBFDB("OI"))) I $G(PSSDBFDB(PSSDBLP,"DRUG_IEN"))'>0,$G(PSSDBFDB("OI"))'>0 Q
- .I $G(PSSDBFDB(PSSDBLP,"DRUG_IEN"))>0,$$EXMT^PSSDSAPI($G(PSSDBFDB(PSSDBLP,"DRUG_IEN"))) Q
- .S PSSDLEM=$$QORDLEM^PSSDSAPL() Q:PSSDLEM=1
- .D INERR^PSSDSAPM Q:PSSENO I $G(PSSDBFDB(PSSDBLP,"DRUG_IEN"))'>0 D FDRUG^PSSDSAPM I PSSDBIFG D ONT^PSSDSAPA
- .I PSSDBIFL,'PSSDBIFG D NXDRUG^PSSDSAPM Q
- .D NDINFO
- .I $G(PSSDBND1),$G(PSSDBND3) D
- ..S PSSDBAR("GCN")=$P($$PROD0^PSNAPIS(PSSDBND1,PSSDBND3),"^",7)
- ..S PSSDBAR("VUID")=$$GETVUID^XTID(50.68,,+PSSDBND3_",")
- .S PSSDBAR("NAME")=$G(PSSDBFDB(PSSDBLP,"DRUG_NM"))
- .D AMT I $G(PSSDBAR("AMN"))'="",$L(PSSDBAR("AMN"))>1,$E(PSSDBAR("AMN"),1)="0" S PSSDBAR("AMN")=$E(PSSDBAR("AMN"),2,$L(PSSDBAR("AMN")))
- .D DTYPE
- .S PSSDBAR("DSE")=$S($D(PSSDBFDB(PSSDBLP,"DOSE_RATE")):$G(PSSDBFDB(PSSDBLP,"DOSE_RATE")),1:"DAY")
- .D RTE
- .D SCHD^PSSSCHMS
- .D DURR
- .D DURRAT
- .S PSSDBAR("SPFC")="" S:$G(PSSDBFDB(PSSDBLP,"ENH")) PSSENHK(PSSDBFDB(PSSDBLP,"RX_NUM"))=1
- .S PSSDBFST=$G(PSSDBAR("GCN"))_"^"_$S($P($G(PSSDBAR("VUID")),"^")'=0:$G(PSSDBAR("VUID")),1:"")_"^"_$S('PSSDBIFL:PSSDBFDB(PSSDBLP,"DRUG_IEN"),PSSDBIFL&(PSSDBIFG):PSSDBIFG,1:"")_"^"_PSSDBAR("NAME")
- .S PSSDBFLG=1
- .S ^TMP($J,PSSDBASE,"IN","PROSPECTIVE",PSSDBFDB(PSSDBLP,"RX_NUM"))=PSSDBFST
- .S ^TMP($J,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))=PSSDBFST_"^"_$G(PSSDBAR("AMN"))_"^"_$G(PSSDBAR("UNIT"))_"^"_PSSDBAR("DSE")_"^"_PSSDBAR("FREQ")_"^"_PSSDBAR("DUR")_"^"_PSSDBAR("DRR")_"^"_PSSDBAR("RT")_"^"_PSSDBAR("TYPE")
- .S ^TMP($J,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))=^TMP($J,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))_"^"_PSSDBAR("SPFC")_"^"_$$DFM^PSSDSEXC
- .S PSSDBFRC(PSSDBFDB(PSSDBLP,"RX_NUM"),"CONJ")=$G(PSSDBDS(PSSDBLP,"CONJ")) S PSSDBFRC(PSSDBFDB(PSSDBLP,"RX_NUM"),"SCHEDULE")=$G(PSSDBDS(PSSDBLP,"SCHEDULE"))
- .I $G(PSSDBDS(PSSDBLP,"DRATE"))'="" I PSSDBDS(PSSDBLP,"DRATE")?.N!(PSSDBDS(PSSDBLP,"DRATE")?.N1".".N) S PSSDBDS(PSSDBLP,"DRATE")=PSSDBDS(PSSDBLP,"DRATE")_"D"
- .S PSSDBFRB(PSSDBFDB(PSSDBLP,"RX_NUM"),"DRATE")=$G(PSSDBDS(PSSDBLP,"DRATE")) D ADJU^PSSDSEXC
- .D INFUE^PSSDSAPM
- .D FRQE^PSSDSAPM
- .S ^TMP($J,"PSSCNX","IN","DOSE",PSSDBLP,PSSDBFDB(PSSDBLP,"RX_NUM"))=^TMP($J,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))
- D COMP ;Set up complex Doses
- S ^TMP($J,PSSDBASE,"IN","IEN")=PSSDBDFN
- S ^TMP($J,PSSDBASE,"IN","DOSE")=""
- D PAT^PSSDSAPM K ^TMP($J,"PSSCNX")
- N PSSDBDGO ; Only go to interface if you have at least one Dose Sequence that needs to go
- S PSSDBDGO=0 I $D(^TMP($J,PSSDBASE,"IN","EXCEPTIONS")) S (PSSDBDGO,PSSDBSNO)=1
- D ERR ;Set up PSSDBCAX error array and default data
- I PSSDBDGO,PSSDBSNO D:$D(PSSDBFTX) FTX^PSSDSAPK D IN^PSSHRQ2(PSSDBASE) D:$D(PSSDBFTX) FTXRS^PSSDSAPK ;2.1 PSSDBSNO check added
- I PSSDBASA!(PSSDBASB) D FMT^PSSDSEXC I $P($G(^TMP($J,PSSDBASE,"OUT",0)),"^")'=-1 D ADDCT^PSSDSAPM,REM^PSSDSAPA
- Q
- AMT ;Set Dose Amount and Dose Unit
- D DPL^PSSDSAPK
- I $D(PSSDBCAZ(PSSDBFDB(PSSDBLP,"RX_NUM"),"NO_DRUG")) D MLTS^PSSDSAPM Q
- N PSSDBUNT,PSSDBFAL,PSSDBXP,PSSDBNOD,PSSDBNT,PSSDSXTD,PSSDBUNA,PSSDBLPD,PSSDSLCL,PSSDSLC1,PSSDSLCT
- S (PSSDBFAL,PSSDBLPD,PSSDSLCT)=0
- I 'PSSDBIFL,$D(PSSDBFDB(PSSDBLP,"DOSE_AMT")),$D(PSSDBFDB(PSSDBLP,"DOSE_UNIT")) S PSSDBAR("AMN")=PSSDBFDB(PSSDBLP,"DOSE_AMT"),PSSDBAR("UNIT")=PSSDBFDB(PSSDBLP,"DOSE_UNIT") D LDZ Q
- I 'PSSDBIFL,$G(PSSDBDS(PSSDBLP,"DRG_AMT")),$G(PSSDBDS(PSSDBLP,"DRG_UNIT"))'="" D
- .;For Drug Units like MG/ML, take first piece of"/"
- .S PSSDBUNT=$S(PSSDBDS(PSSDBLP,"DRG_UNIT")["/":$P(PSSDBDS(PSSDBLP,"DRG_UNIT"),"/"),1:PSSDBDS(PSSDBLP,"DRG_UNIT"))
- .S PSSDBUNT=$$UP^XLFSTR(PSSDBUNT)
- .S PSSDBUNA=$$UNIT^PSSDSAPI(PSSDBUNT)
- .I PSSDBUNA'="" S PSSDBAR("AMN")=PSSDBDS(PSSDBLP,"DRG_AMT"),PSSDBAR("UNIT")=PSSDBUNA,PSSDBFAL=1 D LDZ
- I PSSDBFAL Q
- ;"DOSE" Node should only come from CPRS, for selected Local Possible Dosage
- S PSSDSLCL=$S($G(PSSDBDS(PSSDBLP,"DOSE"))'="":$P(PSSDBDS(PSSDBLP,"DOSE"),"&",5),1:$G(PSSDBDS(PSSDBLP,"DO")))
- I PSSDSLCL["(" D PTH^PSSDSUTL
- I PSSDBIFL D MLT^PSSDSAPM Q
- AMTRT ;Retry for Local Dosages with parenthesis
- I PSSDSLCL'="" D
- .F PSSDBXP=0:0 S PSSDBXP=$O(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"DOS2",PSSDBXP)) Q:'PSSDBXP!(PSSDBFAL) D
- ..S PSSDBNOD=$G(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"DOS2",PSSDBXP,0))
- ..;ignore package of the Local Possible Dose
- ..I $$MTCH^PSSDSAPK S PSSDBLPD=1 I $P(PSSDBNOD,"^",5),$P(PSSDBNOD,"^",6)'="" D
- ...;XTID Screening out Inactive Dose Units
- ...S PSSDSXTD=+$P(PSSDBNOD,"^",5) I PSSDSXTD,$$SCREEN^XTID(51.24,.01,PSSDSXTD_",") Q
- ...S PSSDBNT=$P($G(^PS(51.24,+$P(PSSDBNOD,"^",5),0)),"^",2)
- ...I PSSDBNT'="" S PSSDBAR("AMN")=$P(PSSDBNOD,"^",6),PSSDBAR("UNIT")=PSSDBNT,PSSDBFAL=1
- .;Only do auto-population logic if Local Possible Dosage was not found at all in File 50
- .I PSSDBFAL Q
- .I PSSDBLPD D DPOP^PSSDSAPK I PSSDBFAL Q
- .D ITEM^PSSDSAPK D:'PSSDBFAL NUM^PSSDSAPL D:'PSSDBFAL RANGE^PSSDSUTL
- I 'PSSDBFAL,PSSDSLCT S PSSDSLCL=PSSDSLC1(PSSDSLCT),PSSDSLCT=PSSDSLCT-1,PSSDBLPD=0 G AMTRT
- Q
- LDZ ;
- I $E(PSSDBAR("AMN"))=0,$L(PSSDBAR("AMN"))>1 S PSSDBAR("AMN")=$E(PSSDBAR("AMN"),2,$L(PSSDBAR("AMN")))
- Q
- RTE ;Get First DataBank Med Route
- N PSSDBMRT
- K PSSDBMRT
- I $D(PSSDBFDB(PSSDBLP,"ROUTE")) S PSSDBAR("RT")=PSSDBFDB(PSSDBLP,"ROUTE") Q
- I $G(PSSDBDS(PSSDBLP,"MR_IEN")) S PSSDBMRT=$$MRT^PSSDSAPI(PSSDBDS(PSSDBLP,"MR_IEN")) I $P(PSSDBMRT,"^",2)'="" S PSSDBAR("RT")=$P(PSSDBMRT,"^",2) Q
- S PSSDBAR("RT")=""
- Q
- DTYPE ;Find Dose Type
- N PSSDBST1,PSSDBST2,PSSDBST3,PSSDBST4,PSSDBSTX
- I $D(PSSDBFDB(PSSDBLP,"DOSE_TYPE")) S PSSDBAR("TYPE")=PSSDBFDB(PSSDBLP,"DOSE_TYPE") Q
- S PSSDBST1=$G(PSSDBDS(PSSDBLP,"SCHEDULE"))
- I PSSDBST1="" S PSSDBAR("TYPE")="MAINTENANCE" Q
- S PSSDBST3=0
- ;PSS*1*206
- I PSSDBST1[" PRN",'$D(^PS(51.1,"APPSJ",PSSDBST1)) S PSSDBSTX=$P(PSSDBST1," PRN",1) S:PSSDBSTX]"" PSSDBST1=PSSDBSTX
- F PSSDBST2=0:0 S PSSDBST2=$O(^PS(51.1,"APPSJ",PSSDBST1,PSSDBST2)) Q:'PSSDBST2!(PSSDBST3) D
- .S PSSDBST4=$P($G(^PS(51.1,PSSDBST2,0)),"^",5)
- .I PSSDBST4="O"!(PSSDBST4="OC") S PSSDBAR("TYPE")="SINGLE DOSE",PSSDBST3=1
- I 'PSSDBST3 S PSSDBAR("TYPE")="MAINTENANCE"
- Q
- DURR ;Set Duration
- I $D(PSSDBFDB(PSSDBLP,"DURATION")) S PSSDBAR("DUR")=PSSDBFDB(PSSDBLP,"DURATION") Q
- S PSSDBAR("DUR")=$S($G(PSSDBAR("TYPE"))="SINGLE DOSE":"",1:1)
- Q
- DURRAT ;Set Duration Rate
- I $D(PSSDBFDB(PSSDBLP,"DURATION_RT")) S PSSDBAR("DRR")=PSSDBFDB(PSSDBLP,"DURATION_RT") Q
- S PSSDBAR("DRR")=$S($G(PSSDBAR("TYPE"))="SINGLE DOSE":"",1:"DAY")
- Q
- COMP ;Handle complex order, set PSSDBCAR array, see routine PSSDSEXC for PSSBDCAR piece details
- ;if you have to add new create input entry, just add a piece 5 = 1 to the Pharmacy Order Number
- N PSSDBKLP,PSSDBKUN,PSSDBKMR,PSSDBKND,PSSDBKRF,PSSDBKNW,PSSDBKFL,PSSDBKTM,PSSDBKFQ,PSSDBKGG,PSSCNX1,PSSDBCDA,PSSDCLX
- S PSSDBKTM="PSSTTMP"
- K ^TMP($J,PSSDBKTM)
- S PSSDBKFL=0
- F PSSCNX1=0:0 S PSSCNX1=$O(^TMP($J,"PSSCNX","IN","DOSE",PSSCNX1)) Q:'PSSCNX1 S PSSDBKLP=$O(^TMP($J,"PSSCNX","IN","DOSE",PSSCNX1,"")) I PSSDBKLP'="" D
- .S PSSDBKND=$G(^TMP($J,PSSDBASE,"IN","DOSE",PSSDBKLP)) S PSSDBKFQ=$S($D(PSSDBCAZ(PSSDBKLP,"FRQ_ERROR")):0,1:1) S PSSDBKGG=$S($P(PSSDBKND,"^",12)="SINGLE DOSE":1,1:0)
- .S PSSDBCDA($S($P(PSSDBKND,"^",3)="":"NULL",1:$P(PSSDBKND,"^",3)),$S($P(PSSDBKND,"^",11)="":"NULL",1:$P(PSSDBKND,"^",11)))=PSSDBKLP I $G(PSSDCLX)="" S PSSDCLX=PSSDBKLP ;2.1 removed PSSDSWHE check
- .S PSSDBCAR(PSSDBKLP)="B"_"^"_$P(PSSDBKND,"^",4)_"^"_$P(PSSDBKND,"^",3)_"^"_PSSDBKFQ_"^"_$S($P(PSSDBKND,"^",12)="SINGLE DOSE":0,1:1) S:$G(PSSDBFRC(PSSDBKLP,"CONJ"))="A" $P(PSSDBCAR(PSSDBKLP),"^",7)=1
- .S $P(PSSDBCAR(PSSDBKLP),"^",9)=$P(PSSDBKND,"^",11) D MLTNO^PSSDSAPM,SXCL^PSSDSAPA S:$G(PSSDBFRC(PSSDBKLP,"CONJ"))'=""!($G(PSSDBFRC(PSSDCLX,"CONJ"))'="") $P(PSSDBCAR(PSSDBKLP),"^",16)=1 S PSSDCLX=PSSDBKLP ; 2.1 removed PSSDSWHE check
- .S:'$P(PSSDBCAR(PSSDBKLP),"^",14) PSSDBSNO=1 I $G(PSSDBFRC(PSSDBKLP,"CONJ"))'="A"!($O(^TMP($J,"PSSCNX","IN","DOSE",PSSCNX1))="") S PSSDBKNW($P(PSSDBKLP,";",4),PSSDBKLP)="" D CRT K PSSDBKNW,PSSDBCDA S PSSDBKFL=0 Q
- .S PSSDBKFL=PSSDBKFL+1
- .S PSSDBKNW($P(PSSDBKLP,";",4),PSSDBKLP)=""
- .S $P(PSSDBCAR(PSSDBKLP),"^")="S",$P(PSSDBCAR(PSSDBKLP),"^",12)=1
- I $D(^TMP($J,PSSDBKTM)) M ^TMP($J,PSSDBASE)=^TMP($J,PSSDBKTM)
- K ^TMP($J,PSSDBKTM)
- Q
- DRT(PSSDBJV) ;Return number of minutes based on duration, API also called from Inpatient Medications
- ;If only a numeric is passed in, the API will assume Days
- I $G(PSSDBJV)="" Q -1
- I PSSDBJV?.N1".".N1"D"!(PSSDBJV?.N1"D") Q (1440*+PSSDBJV)
- I PSSDBJV?.N1".".N!(PSSDBJV?.N) Q (1440*+PSSDBJV)
- I PSSDBJV?.N1".".N1"H"!(PSSDBJV?.N1"H") Q (60*+PSSDBJV)
- I PSSDBJV?.N1".".N1"M"!(PSSDBJV?.N1"M") Q (+PSSDBJV)
- I PSSDBJV?.N1".".N1"W"!(PSSDBJV?.N1"W") Q (10080*+PSSDBJV)
- I PSSDBJV?.N1".".N1"L"!(PSSDBJV?.N1"L") Q (43200*+PSSDBJV)
- Q -1
- CRT ;Possibly create new Input Dose Node just for Daily Dose purposes
- I 'PSSDBKFL!($G(PSSDBFRC(PSSDBKLP,"CONJ"))="A") S $P(PSSDBCAR(PSSDBKLP),"^")=$S($G(PSSDBFRC(PSSDBKLP,"CONJ"))="A":"S",$G(PSSDBKGG):"S",$G(PSSDBFRB(PSSDBKLP,"DRATE"))="":"B",1:"B") D S12 Q
- N PSSDBR1,PSSDBR2,PSSDBR3,PSSDBR4,PSSDBR5,PSSDBR6,PSSDBR7,PSSDBRCT,PSSDBRNO,PSSDBRLS,PSSDBR9,PSSDBR91,PSSDBEQ2,PSSDBEQ3,PSSDBEQ4,PSSDBR8,PSSDBXAX,PSSDBRLP,PSSDBRLA
- S (PSSDBRNO,PSSDBRCT,PSSDBR5)=0
- ;Then or Except Conjunction, or last Dosing Sequence in the series, with previous dosages to add up for Daily Dose
- ;PSSDBKNW array holds all previous dosing sequences and current one
- S PSSDBRLP="" F S PSSDBRLP=$O(PSSDBKNW(PSSDBRLP)) Q:PSSDBRLP="" S PSSDBR1=$O(PSSDBKNW(PSSDBRLP,"")) I PSSDBR1'="" D
- .S PSSDBR2=$G(^TMP($J,PSSDBASE,"IN","DOSE",PSSDBR1))
- .I $O(PSSDBKNW(PSSDBRLP))="" S $P(PSSDBCAR(PSSDBKLP),"^")="S",$P(PSSDBCAR(PSSDBKLP),"^",12)=1
- .I $P(PSSDBR2,"^",12)'="MAINTENANCE" D NX(4)
- .S PSSDBRCT=PSSDBRCT+1
- .I $G(PSSDBFRC(PSSDBR1,"SCHEDULE"))["@" D NX(10)
- .I '$D(PSSDBEQ2(10)),$G(PSSDBFRC(PSSDBR1,"SCHEDULE"))'="" F PSSDBEQ4=0:0 S PSSDBEQ4=$O(^PS(51.1,"APPSJ",$G(PSSDBFRC(PSSDBR1,"SCHEDULE")),PSSDBEQ4)) Q:'PSSDBEQ4!($D(PSSDBEQ2(10))) D
- ..I $P($G(^PS(51.1,PSSDBEQ4,0)),"^",5)="D" D NX(10)
- .I PSSDBRCT=1 D Q
- ..I '$P(PSSDBR2,"^",5) D NX(11)
- ..S PSSDBR91=$G(PSSDBFRB(PSSDBR1,"DRATE"))
- ..S PSSDBR3=$P(PSSDBR2,"^",6),PSSDBR4=$P(PSSDBR2,"^",11) I PSSDBR3=""!(PSSDBR4="") S PSSDBRNO=1 D:PSSDBR3="" NX(5) D:PSSDBR4="" NX(6)
- ..S PSSDBR5=$P(PSSDBR2,"^",8)
- ..I $D(PSSDBCAZ(PSSDBR1,"FRQ_ERROR")) D NX(7)
- ..I 'PSSDBRNO S PSSDBR8=$$FRCON^PSSDSAPK(PSSDBR5) S:PSSDBR8'<1 PSSDBR6=$P(PSSDBR2,"^",5)*PSSDBR8 I PSSDBR8<1 D NX(7)
- ..I $G(PSSDBFRB(PSSDBR1,"DRATE"))'="" S PSSDBR7=$$DRT(PSSDBFRB(PSSDBR1,"DRATE")) I PSSDBR7<1440 D NX(9)
- ..I '$O(PSSDBKNW(PSSDBRLP)) S PSSDBRLS=PSSDBR1 ; Get Last entry
- .I '$P(PSSDBR2,"^",5) D NX(11)
- .I PSSDBR3'=$P(PSSDBR2,"^",6) D NX(5)
- .I PSSDBR4'=$P(PSSDBR2,"^",11) D NX(6)
- .I $G(PSSDBFRB(PSSDBR1,"DRATE"))'=PSSDBR91 D NX(8)
- .S PSSDBR5=$P(PSSDBR2,"^",8) I $D(PSSDBCAZ(PSSDBR1,"FRQ_ERROR")) D NX(7)
- .I 'PSSDBRNO S PSSDBR8=$$FRCON^PSSDSAPK(PSSDBR5) S:PSSDBR8'<1 PSSDBR6=PSSDBR6+($P(PSSDBR2,"^",5)*PSSDBR8) I PSSDBR8<1 D NX(7)
- .I $G(PSSDBFRB(PSSDBR1,"DRATE"))'="" S PSSDBR7=$$DRT(PSSDBFRB(PSSDBR1,"DRATE")) I PSSDBR7<1440 D NX(9)
- .I '$O(PSSDBKNW(PSSDBRLP)) S PSSDBRLS=PSSDBR1 ; Get Last entry
- I PSSDBRNO D S $P(PSSDBCAR(PSSDBRLS),"^",8)=1,$P(PSSDBCAR(PSSDBRLS),"^",7)="" D MLTNP^PSSDSAPM Q ;2.1 Removed RESET^PSSDSAPA call - works witn GEN+2^PSSDSEXC add back for 2.2
- .S PSSDBRLA="" F S PSSDBRLA=$O(PSSDBKNW(PSSDBRLA)) Q:PSSDBRLA="" S PSSDBR9=$O(PSSDBKNW(PSSDBRLA,"")) I PSSDBR9'="" S $P(PSSDBCAR(PSSDBR9),"^")="S",$P(PSSDBCAR(PSSDBR9),"^",12)=1
- .;Set error message only for last entry where Daily Dose should have been done
- .D ERST^PSSDSAPM
- S ^TMP($J,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1")=^TMP($J,PSSDBASE,"IN","DOSE",PSSDBRLS)
- S ^TMP($J,PSSDBKTM,"IN","PROSPECTIVE",PSSDBRLS_";1")=$P(^TMP($J,PSSDBASE,"IN","DOSE",PSSDBRLS),"^",1,4)
- S $P(^TMP($J,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1"),"^",8)=1
- S $P(^TMP($J,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1"),"^",5)=PSSDBR6
- S PSSDBCAR(PSSDBRLS_";1")="D"_"^"_$P(PSSDBKND,"^",4)_"^"_$P(PSSDBKND,"^",3)_"^"_PSSDBKFQ S $P(PSSDBCAR(PSSDBRLS),"^",11)=1
- Q
- NDINFO ;Set National Drug File information
- I 'PSSDBIFL,$G(PSSDBFDB(PSSDBLP,"DRUG_IEN")) S PSSDBND1=$P($G(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"ND")),"^"),PSSDBND3=$P($G(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"ND")),"^",3) Q
- I $G(PSSDBIFG) S PSSDBND1=$P($G(^PSDRUG(PSSDBIFG,"ND")),"^"),PSSDBND3=$P($G(^PSDRUG(PSSDBIFG,"ND")),"^",3)
- Q
- ERR ;Loop through PSSDBCAR, set PSSDBCAX error array
- N PSSDBEB1,PSSDBEB2,PSSDBEB3
- S PSSDBEB3=$S($G(^TMP($J,PSSDBASE,"IN","DOSE","AGE")):1,1:0)
- ;Skip AGE, WT and BSA and newly created Dosages for complex additions
- ;Rx_NUM MUST contain a ";", or you will not set PSSDBDGO
- S PSSDBEB1="" F S PSSDBEB1=$O(^TMP($J,PSSDBASE,"IN","DOSE",PSSDBEB1)) Q:PSSDBEB1="" S:'PSSDBEB3&(PSSDBEB1[";") $P(PSSDBCAR(PSSDBEB1),"^",13)=1 D:'$P(PSSDBEB1,";",5)&(PSSDBEB1[";")
- .S PSSDBEB2=$G(^TMP($J,PSSDBASE,"IN","DOSE",PSSDBEB1))
- .I $D(PSSDBCAZ(PSSDBEB1,"INF_ERROR")) D INRATE^PSSDSAPA S PSSDBDGO=1 S $P(PSSDBCAR(PSSDBEB1),"^",13)=1 Q
- .I $P(PSSDBEB2,"^",5)=""!($P(PSSDBEB2,"^",6)="") D BDOSE^PSSDSAPK S $P(PSSDBCAR(PSSDBEB1),"^",13)=1 Q
- .;I $D(PSSDBCAZ(PSSDBEB1,"FRQ_ERROR")) D INFRQ^PSSDSAPA S PSSDBDGO=1 Q ;; 2.1 change, ensure null freq are sent in line below
- .I $$FCY^PSSDSUTA() D INFRQ^PSSDSAPA S PSSDBDGO=1 Q
- .I '$P(PSSDBCAR(PSSDBEB1),"^",5) D SING^PSSDSAPK S PSSDBDGO=1 Q
- .S PSSDBDGO=1
- Q
- EXCPS(PSSDBEQ1) ;Set errors
- I $P(PSSDBCAR(PSSDBEB1),"^",16),PSSDBEQ1=2 Q ;Complex order - remove in 2.2
- I $P(PSSDBCAR(PSSDBEB1),"^",15),PSSDBEQ1=2 Q ;2.1 Don't set Frequency error if Schedule excluded from Daily Dose check
- I PSSDBEQ1=2,$D(PSSDBCAZ(PSSDBEB1,"FRQD_ERROR")) S PSSDBCAX(PSSDBEB1,15)="" Q
- S PSSDBCAX(PSSDBEB1,PSSDBEQ1)=""
- Q
- S12 ;
- S:$P(PSSDBCAR(PSSDBKLP),"^")="S" $P(PSSDBCAR(PSSDBKLP),"^",12)=1
- Q
- NX(PSSNX) ;
- S PSSDBRNO=1
- S PSSDBEQ2(PSSNX)=""
- S PSSDBXAX(PSSNX,PSSDBR1)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSAPD 15661 printed Feb 18, 2025@23:57:06 Page 2
- PSSDSAPD ;BIR/RTR-Main Dose Check API ;09/16/08
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**117,160,173,201,178,206**;9/30/97;Build 10
- +2 ;
- +3 ;Dose Check API
- +4 ;
- +5 ;Input
- +6 ;PSSDBASE = Name of subscript
- +7 ;PSSDBDFN = Patient Internal Entry Number
- +8 ;PSSDBDS = Data to use to build actual Input data, for pieces not sent in PSSDBFDB array
- +9 ;PSSDBFDB = Array where if the node exists, just set that data (even if null) directly into the corresponding API piece
- DOSE(PSSDBASX,PSSDBDFN,PSSDBDS,PSSDBFDB) ;
- +1 IF $GET(PSSDBASX(1))=""
- QUIT
- +2 NEW PSSDBASE,PSSDBASF,PSSDBASG,PSSDBASA,PSSDBASB
- SET PSSDBASE=PSSDBASX(1)
- SET PSSDBASF=$GET(PSSDBASX(2))
- SET PSSDBASG=$GET(PSSDBASX(3))
- KILL ^TMP($JOB,PSSDBASE)
- KILL ^TMP($JOB,"PSSDOSGL")
- KILL ^TMP($JOB,"PSSCNX")
- +3 SET PSSDBASA=0
- IF $GET(PSSDBASF)'=""
- KILL ^TMP($JOB,PSSDBASF)
- SET PSSDBASA=1
- +4 SET PSSDBASB=0
- IF $GET(PSSDBASG)'=""
- KILL ^TMP($JOB,PSSDBASG)
- SET PSSDBASB=1
- +5 SET ^TMP($JOB,PSSDBASE,"IN","PING")=""
- DO IN^PSSHRQ2(PSSDBASE)
- +6 IF $PIECE($GET(^TMP($JOB,PSSDBASE,"OUT",0)),"^")=-1
- DO DOWN^PSSDSAPK
- QUIT
- +7 KILL ^TMP($JOB,PSSDBASE)
- +8 NEW PSSDBLP,PSSDBND1,PSSDBND3,PSSDBAR,PSSDBFST,PSSDBFLG,PSSDBCOT,PSSDBCAR,PSSDBFRC,PSSDBFRB,PSSDBIFL,PSSDBIFG,PSSDBCAX,PSSDBCAZ,PSSDBFTX,PSSDBADJ,PSSDBCDP,PSSDSDPL,PSSDSWHE,PSSENHK,PSSENHKZ,PSSDSIVF,PSSENO,PSSDBSNO,PSSDLEM
- +9 IF +$GET(PSSDBDFN)'>0
- QUIT
- +10 ;2.1 PSSDBSNO added - remains at 0 if all schedules are excluded from all Dosing checks, set in Comp Tag
- SET (PSSDBFLG,PSSDBSNO)=0
- SET PSSDSWHE=$SELECT($EXTRACT($GET(PSSDBASE),1,2)="OR":1,1:0)
- +11 FOR PSSDBLP=0:0
- SET PSSDBLP=$ORDER(PSSDBFDB(PSSDBLP))
- if 'PSSDBLP
- QUIT
- Begin DoDot:1
- +12 KILL PSSDBAR,PSSDBND1,PSSDBND3
- SET (PSSDBIFL,PSSDBIFG,PSSDSIVF,PSSENO)=0
- +13 IF $GET(PSSDBFDB(PSSDBLP,"RX_NUM"))=""
- QUIT
- +14 IF $GET(PSSDBFDB(PSSDBLP,"DRUG_NM"))=""
- QUIT
- +15 SET PSSDBFDB("OI")=$SELECT($GET(PSSDBFDB(PSSDBLP,"OI")):$GET(PSSDBFDB(PSSDBLP,"OI")),1:$GET(PSSDBFDB("OI")))
- IF $GET(PSSDBFDB(PSSDBLP,"DRUG_IEN"))'>0
- IF $GET(PSSDBFDB("OI"))'>0
- QUIT
- +16 IF $GET(PSSDBFDB(PSSDBLP,"DRUG_IEN"))>0
- IF $$EXMT^PSSDSAPI($GET(PSSDBFDB(PSSDBLP,"DRUG_IEN")))
- QUIT
- +17 SET PSSDLEM=$$QORDLEM^PSSDSAPL()
- if PSSDLEM=1
- QUIT
- +18 DO INERR^PSSDSAPM
- if PSSENO
- QUIT
- IF $GET(PSSDBFDB(PSSDBLP,"DRUG_IEN"))'>0
- DO FDRUG^PSSDSAPM
- IF PSSDBIFG
- DO ONT^PSSDSAPA
- +19 IF PSSDBIFL
- IF 'PSSDBIFG
- DO NXDRUG^PSSDSAPM
- QUIT
- +20 DO NDINFO
- +21 IF $GET(PSSDBND1)
- IF $GET(PSSDBND3)
- Begin DoDot:2
- +22 SET PSSDBAR("GCN")=$PIECE($$PROD0^PSNAPIS(PSSDBND1,PSSDBND3),"^",7)
- +23 SET PSSDBAR("VUID")=$$GETVUID^XTID(50.68,,+PSSDBND3_",")
- End DoDot:2
- +24 SET PSSDBAR("NAME")=$GET(PSSDBFDB(PSSDBLP,"DRUG_NM"))
- +25 DO AMT
- IF $GET(PSSDBAR("AMN"))'=""
- IF $LENGTH(PSSDBAR("AMN"))>1
- IF $EXTRACT(PSSDBAR("AMN"),1)="0"
- SET PSSDBAR("AMN")=$EXTRACT(PSSDBAR("AMN"),2,$LENGTH(PSSDBAR("AMN")))
- +26 DO DTYPE
- +27 SET PSSDBAR("DSE")=$SELECT($DATA(PSSDBFDB(PSSDBLP,"DOSE_RATE")):$GET(PSSDBFDB(PSSDBLP,"DOSE_RATE")),1:"DAY")
- +28 DO RTE
- +29 DO SCHD^PSSSCHMS
- +30 DO DURR
- +31 DO DURRAT
- +32 SET PSSDBAR("SPFC")=""
- if $GET(PSSDBFDB(PSSDBLP,"ENH"))
- SET PSSENHK(PSSDBFDB(PSSDBLP,"RX_NUM"))=1
- +33 SET PSSDBFST=$GET(PSSDBAR("GCN"))_"^"_$SELECT($PIECE($GET(PSSDBAR("VUID")),"^")'=0:$GET(PSSDBAR("VUID")),1:"")_"^"_$SELECT('PSSDBIFL:PSSDBFDB(PSSDBLP,"DRUG_IEN"),PSSDBIFL&(PSSDBIFG):PSSDBIFG,1:"")_"^"_PSSDBAR("NAME")
- +34 SET PSSDBFLG=1
- +35 SET ^TMP($JOB,PSSDBASE,"IN","PROSPECTIVE",PSSDBFDB(PSSDBLP,"RX_NUM"))=PSSDBFST
- +36 SET ^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))=PSSDBFST_"^"_$GET(PSSDBAR("AMN"))_"^"_$GET(PSSDBAR("UNIT"))_"^"_PSSDBAR("DSE")_"^"_PSSDBAR("FREQ")_"^"_PSSDBAR("DUR")_"^"_PSSDBAR("DRR")_"^"_PSSDBAR("RT")_"^"_PSSDBAR("TYPE"
- )
- +37 SET ^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))=^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))_"^"_PSSDBAR("SPFC")_"^"_$$DFM^PSSDSEXC
- +38 SET PSSDBFRC(PSSDBFDB(PSSDBLP,"RX_NUM"),"CONJ")=$GET(PSSDBDS(PSSDBLP,"CONJ"))
- SET PSSDBFRC(PSSDBFDB(PSSDBLP,"RX_NUM"),"SCHEDULE")=$GET(PSSDBDS(PSSDBLP,"SCHEDULE"))
- +39 IF $GET(PSSDBDS(PSSDBLP,"DRATE"))'=""
- IF PSSDBDS(PSSDBLP,"DRATE")?.N!(PSSDBDS(PSSDBLP,"DRATE")?.N1".".N)
- SET PSSDBDS(PSSDBLP,"DRATE")=PSSDBDS(PSSDBLP,"DRATE")_"D"
- +40 SET PSSDBFRB(PSSDBFDB(PSSDBLP,"RX_NUM"),"DRATE")=$GET(PSSDBDS(PSSDBLP,"DRATE"))
- DO ADJU^PSSDSEXC
- +41 DO INFUE^PSSDSAPM
- +42 DO FRQE^PSSDSAPM
- +43 SET ^TMP($JOB,"PSSCNX","IN","DOSE",PSSDBLP,PSSDBFDB(PSSDBLP,"RX_NUM"))=^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBFDB(PSSDBLP,"RX_NUM"))
- End DoDot:1
- +44 ;Set up complex Doses
- DO COMP
- +45 SET ^TMP($JOB,PSSDBASE,"IN","IEN")=PSSDBDFN
- +46 SET ^TMP($JOB,PSSDBASE,"IN","DOSE")=""
- +47 DO PAT^PSSDSAPM
- KILL ^TMP($JOB,"PSSCNX")
- +48 ; Only go to interface if you have at least one Dose Sequence that needs to go
- NEW PSSDBDGO
- +49 SET PSSDBDGO=0
- IF $DATA(^TMP($JOB,PSSDBASE,"IN","EXCEPTIONS"))
- SET (PSSDBDGO,PSSDBSNO)=1
- +50 ;Set up PSSDBCAX error array and default data
- DO ERR
- +51 ;2.1 PSSDBSNO check added
- IF PSSDBDGO
- IF PSSDBSNO
- if $DATA(PSSDBFTX)
- DO FTX^PSSDSAPK
- DO IN^PSSHRQ2(PSSDBASE)
- if $DATA(PSSDBFTX)
- DO FTXRS^PSSDSAPK
- +52 IF PSSDBASA!(PSSDBASB)
- DO FMT^PSSDSEXC
- IF $PIECE($GET(^TMP($JOB,PSSDBASE,"OUT",0)),"^")'=-1
- DO ADDCT^PSSDSAPM
- DO REM^PSSDSAPA
- +53 QUIT
- AMT ;Set Dose Amount and Dose Unit
- +1 DO DPL^PSSDSAPK
- +2 IF $DATA(PSSDBCAZ(PSSDBFDB(PSSDBLP,"RX_NUM"),"NO_DRUG"))
- DO MLTS^PSSDSAPM
- QUIT
- +3 NEW PSSDBUNT,PSSDBFAL,PSSDBXP,PSSDBNOD,PSSDBNT,PSSDSXTD,PSSDBUNA,PSSDBLPD,PSSDSLCL,PSSDSLC1,PSSDSLCT
- +4 SET (PSSDBFAL,PSSDBLPD,PSSDSLCT)=0
- +5 IF 'PSSDBIFL
- IF $DATA(PSSDBFDB(PSSDBLP,"DOSE_AMT"))
- IF $DATA(PSSDBFDB(PSSDBLP,"DOSE_UNIT"))
- SET PSSDBAR("AMN")=PSSDBFDB(PSSDBLP,"DOSE_AMT")
- SET PSSDBAR("UNIT")=PSSDBFDB(PSSDBLP,"DOSE_UNIT")
- DO LDZ
- QUIT
- +6 IF 'PSSDBIFL
- IF $GET(PSSDBDS(PSSDBLP,"DRG_AMT"))
- IF $GET(PSSDBDS(PSSDBLP,"DRG_UNIT"))'=""
- Begin DoDot:1
- +7 ;For Drug Units like MG/ML, take first piece of"/"
- +8 SET PSSDBUNT=$SELECT(PSSDBDS(PSSDBLP,"DRG_UNIT")["/":$PIECE(PSSDBDS(PSSDBLP,"DRG_UNIT"),"/"),1:PSSDBDS(PSSDBLP,"DRG_UNIT"))
- +9 SET PSSDBUNT=$$UP^XLFSTR(PSSDBUNT)
- +10 SET PSSDBUNA=$$UNIT^PSSDSAPI(PSSDBUNT)
- +11 IF PSSDBUNA'=""
- SET PSSDBAR("AMN")=PSSDBDS(PSSDBLP,"DRG_AMT")
- SET PSSDBAR("UNIT")=PSSDBUNA
- SET PSSDBFAL=1
- DO LDZ
- End DoDot:1
- +12 IF PSSDBFAL
- QUIT
- +13 ;"DOSE" Node should only come from CPRS, for selected Local Possible Dosage
- +14 SET PSSDSLCL=$SELECT($GET(PSSDBDS(PSSDBLP,"DOSE"))'="":$PIECE(PSSDBDS(PSSDBLP,"DOSE"),"&",5),1:$GET(PSSDBDS(PSSDBLP,"DO")))
- +15 IF PSSDSLCL["("
- DO PTH^PSSDSUTL
- +16 IF PSSDBIFL
- DO MLT^PSSDSAPM
- QUIT
- AMTRT ;Retry for Local Dosages with parenthesis
- +1 IF PSSDSLCL'=""
- Begin DoDot:1
- +2 FOR PSSDBXP=0:0
- SET PSSDBXP=$ORDER(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"DOS2",PSSDBXP))
- if 'PSSDBXP!(PSSDBFAL)
- QUIT
- Begin DoDot:2
- +3 SET PSSDBNOD=$GET(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"DOS2",PSSDBXP,0))
- +4 ;ignore package of the Local Possible Dose
- +5 IF $$MTCH^PSSDSAPK
- SET PSSDBLPD=1
- IF $PIECE(PSSDBNOD,"^",5)
- IF $PIECE(PSSDBNOD,"^",6)'=""
- Begin DoDot:3
- +6 ;XTID Screening out Inactive Dose Units
- +7 SET PSSDSXTD=+$PIECE(PSSDBNOD,"^",5)
- IF PSSDSXTD
- IF $$SCREEN^XTID(51.24,.01,PSSDSXTD_",")
- QUIT
- +8 SET PSSDBNT=$PIECE($GET(^PS(51.24,+$PIECE(PSSDBNOD,"^",5),0)),"^",2)
- +9 IF PSSDBNT'=""
- SET PSSDBAR("AMN")=$PIECE(PSSDBNOD,"^",6)
- SET PSSDBAR("UNIT")=PSSDBNT
- SET PSSDBFAL=1
- End DoDot:3
- End DoDot:2
- +10 ;Only do auto-population logic if Local Possible Dosage was not found at all in File 50
- +11 IF PSSDBFAL
- QUIT
- +12 IF PSSDBLPD
- DO DPOP^PSSDSAPK
- IF PSSDBFAL
- QUIT
- +13 DO ITEM^PSSDSAPK
- if 'PSSDBFAL
- DO NUM^PSSDSAPL
- if 'PSSDBFAL
- DO RANGE^PSSDSUTL
- End DoDot:1
- +14 IF 'PSSDBFAL
- IF PSSDSLCT
- SET PSSDSLCL=PSSDSLC1(PSSDSLCT)
- SET PSSDSLCT=PSSDSLCT-1
- SET PSSDBLPD=0
- GOTO AMTRT
- +15 QUIT
- LDZ ;
- +1 IF $EXTRACT(PSSDBAR("AMN"))=0
- IF $LENGTH(PSSDBAR("AMN"))>1
- SET PSSDBAR("AMN")=$EXTRACT(PSSDBAR("AMN"),2,$LENGTH(PSSDBAR("AMN")))
- +2 QUIT
- RTE ;Get First DataBank Med Route
- +1 NEW PSSDBMRT
- +2 KILL PSSDBMRT
- +3 IF $DATA(PSSDBFDB(PSSDBLP,"ROUTE"))
- SET PSSDBAR("RT")=PSSDBFDB(PSSDBLP,"ROUTE")
- QUIT
- +4 IF $GET(PSSDBDS(PSSDBLP,"MR_IEN"))
- SET PSSDBMRT=$$MRT^PSSDSAPI(PSSDBDS(PSSDBLP,"MR_IEN"))
- IF $PIECE(PSSDBMRT,"^",2)'=""
- SET PSSDBAR("RT")=$PIECE(PSSDBMRT,"^",2)
- QUIT
- +5 SET PSSDBAR("RT")=""
- +6 QUIT
- DTYPE ;Find Dose Type
- +1 NEW PSSDBST1,PSSDBST2,PSSDBST3,PSSDBST4,PSSDBSTX
- +2 IF $DATA(PSSDBFDB(PSSDBLP,"DOSE_TYPE"))
- SET PSSDBAR("TYPE")=PSSDBFDB(PSSDBLP,"DOSE_TYPE")
- QUIT
- +3 SET PSSDBST1=$GET(PSSDBDS(PSSDBLP,"SCHEDULE"))
- +4 IF PSSDBST1=""
- SET PSSDBAR("TYPE")="MAINTENANCE"
- QUIT
- +5 SET PSSDBST3=0
- +6 ;PSS*1*206
- +7 IF PSSDBST1[" PRN"
- IF '$DATA(^PS(51.1,"APPSJ",PSSDBST1))
- SET PSSDBSTX=$PIECE(PSSDBST1," PRN",1)
- if PSSDBSTX]""
- SET PSSDBST1=PSSDBSTX
- +8 FOR PSSDBST2=0:0
- SET PSSDBST2=$ORDER(^PS(51.1,"APPSJ",PSSDBST1,PSSDBST2))
- if 'PSSDBST2!(PSSDBST3)
- QUIT
- Begin DoDot:1
- +9 SET PSSDBST4=$PIECE($GET(^PS(51.1,PSSDBST2,0)),"^",5)
- +10 IF PSSDBST4="O"!(PSSDBST4="OC")
- SET PSSDBAR("TYPE")="SINGLE DOSE"
- SET PSSDBST3=1
- End DoDot:1
- +11 IF 'PSSDBST3
- SET PSSDBAR("TYPE")="MAINTENANCE"
- +12 QUIT
- DURR ;Set Duration
- +1 IF $DATA(PSSDBFDB(PSSDBLP,"DURATION"))
- SET PSSDBAR("DUR")=PSSDBFDB(PSSDBLP,"DURATION")
- QUIT
- +2 SET PSSDBAR("DUR")=$SELECT($GET(PSSDBAR("TYPE"))="SINGLE DOSE":"",1:1)
- +3 QUIT
- DURRAT ;Set Duration Rate
- +1 IF $DATA(PSSDBFDB(PSSDBLP,"DURATION_RT"))
- SET PSSDBAR("DRR")=PSSDBFDB(PSSDBLP,"DURATION_RT")
- QUIT
- +2 SET PSSDBAR("DRR")=$SELECT($GET(PSSDBAR("TYPE"))="SINGLE DOSE":"",1:"DAY")
- +3 QUIT
- COMP ;Handle complex order, set PSSDBCAR array, see routine PSSDSEXC for PSSBDCAR piece details
- +1 ;if you have to add new create input entry, just add a piece 5 = 1 to the Pharmacy Order Number
- +2 NEW PSSDBKLP,PSSDBKUN,PSSDBKMR,PSSDBKND,PSSDBKRF,PSSDBKNW,PSSDBKFL,PSSDBKTM,PSSDBKFQ,PSSDBKGG,PSSCNX1,PSSDBCDA,PSSDCLX
- +3 SET PSSDBKTM="PSSTTMP"
- +4 KILL ^TMP($JOB,PSSDBKTM)
- +5 SET PSSDBKFL=0
- +6 FOR PSSCNX1=0:0
- SET PSSCNX1=$ORDER(^TMP($JOB,"PSSCNX","IN","DOSE",PSSCNX1))
- if 'PSSCNX1
- QUIT
- SET PSSDBKLP=$ORDER(^TMP($JOB,"PSSCNX","IN","DOSE",PSSCNX1,""))
- IF PSSDBKLP'=""
- Begin DoDot:1
- +7 SET PSSDBKND=$GET(^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBKLP))
- SET PSSDBKFQ=$SELECT($DATA(PSSDBCAZ(PSSDBKLP,"FRQ_ERROR")):0,1:1)
- SET PSSDBKGG=$SELECT($PIECE(PSSDBKND,"^",12)="SINGLE DOSE":1,1:0)
- +8 ;2.1 removed PSSDSWHE check
- SET PSSDBCDA($SELECT($PIECE(PSSDBKND,"^",3)="":"NULL",1:$PIECE(PSSDBKND,"^",3)),$SELECT($PIECE(PSSDBKND,"^",11)="":"NULL",1:$PIECE(PSSDBKND,"^",11)))=PSSDBKLP
- IF $GET(PSSDCLX)=""
- SET PSSDCLX=PSSDBKLP
- +9 SET PSSDBCAR(PSSDBKLP)="B"_"^"_$PIECE(PSSDBKND,"^",4)_"^"_$PIECE(PSSDBKND,"^",3)_"^"_PSSDBKFQ_"^"_$SELECT($PIECE(PSSDBKND,"^",12)="SINGLE DOSE":0,1:1)
- if $GET(PSSDBFRC(PSSDBKLP,"CONJ"))="A"
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",7)=1
- +10 ; 2.1 removed PSSDSWHE check
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",9)=$PIECE(PSSDBKND,"^",11)
- DO MLTNO^PSSDSAPM
- DO SXCL^PSSDSAPA
- if $GET(PSSDBFRC(PSSDBKLP,"CONJ"))'=""!($GET(PSSDBFRC(PSSDCLX,"CONJ"))'="")
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",16)=1
- SET PSSDCLX=PSSDBKLP
- +11 if '$PIECE(PSSDBCAR(PSSDBKLP),"^",14)
- SET PSSDBSNO=1
- IF $GET(PSSDBFRC(PSSDBKLP,"CONJ"))'="A"!($ORDER(^TMP($JOB,"PSSCNX","IN","DOSE",PSSCNX1))="")
- SET PSSDBKNW($PIECE(PSSDBKLP,";",4),PSSDBKLP)=""
- DO CRT
- KILL PSSDBKNW,PSSDBCDA
- SET PSSDBKFL=0
- QUIT
- +12 SET PSSDBKFL=PSSDBKFL+1
- +13 SET PSSDBKNW($PIECE(PSSDBKLP,";",4),PSSDBKLP)=""
- +14 SET $PIECE(PSSDBCAR(PSSDBKLP),"^")="S"
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",12)=1
- End DoDot:1
- +15 IF $DATA(^TMP($JOB,PSSDBKTM))
- MERGE ^TMP($JOB,PSSDBASE)=^TMP($JOB,PSSDBKTM)
- +16 KILL ^TMP($JOB,PSSDBKTM)
- +17 QUIT
- DRT(PSSDBJV) ;Return number of minutes based on duration, API also called from Inpatient Medications
- +1 ;If only a numeric is passed in, the API will assume Days
- +2 IF $GET(PSSDBJV)=""
- QUIT -1
- +3 IF PSSDBJV?.N1".".N1"D"!(PSSDBJV?.N1"D")
- QUIT (1440*+PSSDBJV)
- +4 IF PSSDBJV?.N1".".N!(PSSDBJV?.N)
- QUIT (1440*+PSSDBJV)
- +5 IF PSSDBJV?.N1".".N1"H"!(PSSDBJV?.N1"H")
- QUIT (60*+PSSDBJV)
- +6 IF PSSDBJV?.N1".".N1"M"!(PSSDBJV?.N1"M")
- QUIT (+PSSDBJV)
- +7 IF PSSDBJV?.N1".".N1"W"!(PSSDBJV?.N1"W")
- QUIT (10080*+PSSDBJV)
- +8 IF PSSDBJV?.N1".".N1"L"!(PSSDBJV?.N1"L")
- QUIT (43200*+PSSDBJV)
- +9 QUIT -1
- CRT ;Possibly create new Input Dose Node just for Daily Dose purposes
- +1 IF 'PSSDBKFL!($GET(PSSDBFRC(PSSDBKLP,"CONJ"))="A")
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^")=$SELECT($GET(PSSDBFRC(PSSDBKLP,"CONJ"))="A":"S",$GET(PSSDBKGG):"S",$GET(PSSDBFRB(PSSDBKLP,"DRATE"))="":"B",1:"B")
- DO S12
- QUIT
- +2 NEW PSSDBR1,PSSDBR2,PSSDBR3,PSSDBR4,PSSDBR5,PSSDBR6,PSSDBR7,PSSDBRCT,PSSDBRNO,PSSDBRLS,PSSDBR9,PSSDBR91,PSSDBEQ2,PSSDBEQ3,PSSDBEQ4,PSSDBR8,PSSDBXAX,PSSDBRLP,PSSDBRLA
- +3 SET (PSSDBRNO,PSSDBRCT,PSSDBR5)=0
- +4 ;Then or Except Conjunction, or last Dosing Sequence in the series, with previous dosages to add up for Daily Dose
- +5 ;PSSDBKNW array holds all previous dosing sequences and current one
- +6 SET PSSDBRLP=""
- FOR
- SET PSSDBRLP=$ORDER(PSSDBKNW(PSSDBRLP))
- if PSSDBRLP=""
- QUIT
- SET PSSDBR1=$ORDER(PSSDBKNW(PSSDBRLP,""))
- IF PSSDBR1'=""
- Begin DoDot:1
- +7 SET PSSDBR2=$GET(^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBR1))
- +8 IF $ORDER(PSSDBKNW(PSSDBRLP))=""
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^")="S"
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",12)=1
- +9 IF $PIECE(PSSDBR2,"^",12)'="MAINTENANCE"
- DO NX(4)
- +10 SET PSSDBRCT=PSSDBRCT+1
- +11 IF $GET(PSSDBFRC(PSSDBR1,"SCHEDULE"))["@"
- DO NX(10)
- +12 IF '$DATA(PSSDBEQ2(10))
- IF $GET(PSSDBFRC(PSSDBR1,"SCHEDULE"))'=""
- FOR PSSDBEQ4=0:0
- SET PSSDBEQ4=$ORDER(^PS(51.1,"APPSJ",$GET(PSSDBFRC(PSSDBR1,"SCHEDULE")),PSSDBEQ4))
- if 'PSSDBEQ4!($DATA(PSSDBEQ2(10)))
- QUIT
- Begin DoDot:2
- +13 IF $PIECE($GET(^PS(51.1,PSSDBEQ4,0)),"^",5)="D"
- DO NX(10)
- End DoDot:2
- +14 IF PSSDBRCT=1
- Begin DoDot:2
- +15 IF '$PIECE(PSSDBR2,"^",5)
- DO NX(11)
- +16 SET PSSDBR91=$GET(PSSDBFRB(PSSDBR1,"DRATE"))
- +17 SET PSSDBR3=$PIECE(PSSDBR2,"^",6)
- SET PSSDBR4=$PIECE(PSSDBR2,"^",11)
- IF PSSDBR3=""!(PSSDBR4="")
- SET PSSDBRNO=1
- if PSSDBR3=""
- DO NX(5)
- if PSSDBR4=""
- DO NX(6)
- +18 SET PSSDBR5=$PIECE(PSSDBR2,"^",8)
- +19 IF $DATA(PSSDBCAZ(PSSDBR1,"FRQ_ERROR"))
- DO NX(7)
- +20 IF 'PSSDBRNO
- SET PSSDBR8=$$FRCON^PSSDSAPK(PSSDBR5)
- if PSSDBR8'<1
- SET PSSDBR6=$PIECE(PSSDBR2,"^",5)*PSSDBR8
- IF PSSDBR8<1
- DO NX(7)
- +21 IF $GET(PSSDBFRB(PSSDBR1,"DRATE"))'=""
- SET PSSDBR7=$$DRT(PSSDBFRB(PSSDBR1,"DRATE"))
- IF PSSDBR7<1440
- DO NX(9)
- +22 ; Get Last entry
- IF '$ORDER(PSSDBKNW(PSSDBRLP))
- SET PSSDBRLS=PSSDBR1
- End DoDot:2
- QUIT
- +23 IF '$PIECE(PSSDBR2,"^",5)
- DO NX(11)
- +24 IF PSSDBR3'=$PIECE(PSSDBR2,"^",6)
- DO NX(5)
- +25 IF PSSDBR4'=$PIECE(PSSDBR2,"^",11)
- DO NX(6)
- +26 IF $GET(PSSDBFRB(PSSDBR1,"DRATE"))'=PSSDBR91
- DO NX(8)
- +27 SET PSSDBR5=$PIECE(PSSDBR2,"^",8)
- IF $DATA(PSSDBCAZ(PSSDBR1,"FRQ_ERROR"))
- DO NX(7)
- +28 IF 'PSSDBRNO
- SET PSSDBR8=$$FRCON^PSSDSAPK(PSSDBR5)
- if PSSDBR8'<1
- SET PSSDBR6=PSSDBR6+($PIECE(PSSDBR2,"^",5)*PSSDBR8)
- IF PSSDBR8<1
- DO NX(7)
- +29 IF $GET(PSSDBFRB(PSSDBR1,"DRATE"))'=""
- SET PSSDBR7=$$DRT(PSSDBFRB(PSSDBR1,"DRATE"))
- IF PSSDBR7<1440
- DO NX(9)
- +30 ; Get Last entry
- IF '$ORDER(PSSDBKNW(PSSDBRLP))
- SET PSSDBRLS=PSSDBR1
- End DoDot:1
- +31 ;2.1 Removed RESET^PSSDSAPA call - works witn GEN+2^PSSDSEXC add back for 2.2
- IF PSSDBRNO
- Begin DoDot:1
- +32 SET PSSDBRLA=""
- FOR
- SET PSSDBRLA=$ORDER(PSSDBKNW(PSSDBRLA))
- if PSSDBRLA=""
- QUIT
- SET PSSDBR9=$ORDER(PSSDBKNW(PSSDBRLA,""))
- IF PSSDBR9'=""
- SET $PIECE(PSSDBCAR(PSSDBR9),"^")="S"
- SET $PIECE(PSSDBCAR(PSSDBR9),"^",12)=1
- +33 ;Set error message only for last entry where Daily Dose should have been done
- +34 DO ERST^PSSDSAPM
- End DoDot:1
- SET $PIECE(PSSDBCAR(PSSDBRLS),"^",8)=1
- SET $PIECE(PSSDBCAR(PSSDBRLS),"^",7)=""
- DO MLTNP^PSSDSAPM
- QUIT
- +35 SET ^TMP($JOB,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1")=^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBRLS)
- +36 SET ^TMP($JOB,PSSDBKTM,"IN","PROSPECTIVE",PSSDBRLS_";1")=$PIECE(^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBRLS),"^",1,4)
- +37 SET $PIECE(^TMP($JOB,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1"),"^",8)=1
- +38 SET $PIECE(^TMP($JOB,PSSDBKTM,"IN","DOSE",PSSDBRLS_";1"),"^",5)=PSSDBR6
- +39 SET PSSDBCAR(PSSDBRLS_";1")="D"_"^"_$PIECE(PSSDBKND,"^",4)_"^"_$PIECE(PSSDBKND,"^",3)_"^"_PSSDBKFQ
- SET $PIECE(PSSDBCAR(PSSDBRLS),"^",11)=1
- +40 QUIT
- NDINFO ;Set National Drug File information
- +1 IF 'PSSDBIFL
- IF $GET(PSSDBFDB(PSSDBLP,"DRUG_IEN"))
- SET PSSDBND1=$PIECE($GET(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"ND")),"^")
- SET PSSDBND3=$PIECE($GET(^PSDRUG(PSSDBFDB(PSSDBLP,"DRUG_IEN"),"ND")),"^",3)
- QUIT
- +2 IF $GET(PSSDBIFG)
- SET PSSDBND1=$PIECE($GET(^PSDRUG(PSSDBIFG,"ND")),"^")
- SET PSSDBND3=$PIECE($GET(^PSDRUG(PSSDBIFG,"ND")),"^",3)
- +3 QUIT
- ERR ;Loop through PSSDBCAR, set PSSDBCAX error array
- +1 NEW PSSDBEB1,PSSDBEB2,PSSDBEB3
- +2 SET PSSDBEB3=$SELECT($GET(^TMP($JOB,PSSDBASE,"IN","DOSE","AGE")):1,1:0)
- +3 ;Skip AGE, WT and BSA and newly created Dosages for complex additions
- +4 ;Rx_NUM MUST contain a ";", or you will not set PSSDBDGO
- +5 SET PSSDBEB1=""
- FOR
- SET PSSDBEB1=$ORDER(^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBEB1))
- if PSSDBEB1=""
- QUIT
- if 'PSSDBEB3&(PSSDBEB1[";")
- SET $PIECE(PSSDBCAR(PSSDBEB1),"^",13)=1
- if '$PIECE(PSSDBEB1,";",5)&(PSSDBEB1[";")
- Begin DoDot:1
- +6 SET PSSDBEB2=$GET(^TMP($JOB,PSSDBASE,"IN","DOSE",PSSDBEB1))
- +7 IF $DATA(PSSDBCAZ(PSSDBEB1,"INF_ERROR"))
- DO INRATE^PSSDSAPA
- SET PSSDBDGO=1
- SET $PIECE(PSSDBCAR(PSSDBEB1),"^",13)=1
- QUIT
- +8 IF $PIECE(PSSDBEB2,"^",5)=""!($PIECE(PSSDBEB2,"^",6)="")
- DO BDOSE^PSSDSAPK
- SET $PIECE(PSSDBCAR(PSSDBEB1),"^",13)=1
- QUIT
- +9 ;I $D(PSSDBCAZ(PSSDBEB1,"FRQ_ERROR")) D INFRQ^PSSDSAPA S PSSDBDGO=1 Q ;; 2.1 change, ensure null freq are sent in line below
- +10 IF $$FCY^PSSDSUTA()
- DO INFRQ^PSSDSAPA
- SET PSSDBDGO=1
- QUIT
- +11 IF '$PIECE(PSSDBCAR(PSSDBEB1),"^",5)
- DO SING^PSSDSAPK
- SET PSSDBDGO=1
- QUIT
- +12 SET PSSDBDGO=1
- End DoDot:1
- +13 QUIT
- EXCPS(PSSDBEQ1) ;Set errors
- +1 ;Complex order - remove in 2.2
- IF $PIECE(PSSDBCAR(PSSDBEB1),"^",16)
- IF PSSDBEQ1=2
- QUIT
- +2 ;2.1 Don't set Frequency error if Schedule excluded from Daily Dose check
- IF $PIECE(PSSDBCAR(PSSDBEB1),"^",15)
- IF PSSDBEQ1=2
- QUIT
- +3 IF PSSDBEQ1=2
- IF $DATA(PSSDBCAZ(PSSDBEB1,"FRQD_ERROR"))
- SET PSSDBCAX(PSSDBEB1,15)=""
- QUIT
- +4 SET PSSDBCAX(PSSDBEB1,PSSDBEQ1)=""
- +5 QUIT
- S12 ;
- +1 if $PIECE(PSSDBCAR(PSSDBKLP),"^")="S"
- SET $PIECE(PSSDBCAR(PSSDBKLP),"^",12)=1
- +2 QUIT
- NX(PSSNX) ;
- +1 SET PSSDBRNO=1
- +2 SET PSSDBEQ2(PSSNX)=""
- +3 SET PSSDBXAX(PSSNX,PSSDBR1)=""
- +4 QUIT