PSODOSCL ;BIR/RTR-Dose Call Utility Routine ;10/07/08
;;7.0;OUTPATIENT PHARMACY;**251,402**;DEC 1997;Build 8
;
;Reference to ^PSDRUG( supported by DBIA 221
;Reference to ^PS(50.7 supported by DBIA 2223
;External reference to $$FRQ^PSSDSAPI supported by DBIA 5425
;External reference to $$MRT^PSSDSAPI supported by DBIA 5425
;External reference to $$UNIT^PSSDSAPI supported by DBIA 5425
;External reference to $$DOSE^PSSDSAPD supported by DBIA 5426
;PSODARTX = Literal Subscript
;PSODAR = Internal Prescription Number from Prescription (#52) File
;
RX(PSODARTX,PSODARX) ;
;use Psodar
N PSODAR1,PSODAR2,PSODARZ,PSODARL,PSODARCT,PSODAR6
S PSODARZ=$G(^PSRX(PSODARX,0))
I '$P(PSODARZ,"^",2)!('$P(PSODARZ,"^",6)) Q
S PSODAR1("PACKAGE")="O"
S PSODAR1("OI")=$P($G(^PSDRUG($P(PSODARZ,"^",6),2)),"^")
S PSODARCT=0
F PSODARL=0:0 S PSODARL=$O(^PSRX(PSODARX,6,PSODARL)) Q:'PSODARL D
.S PSODAR1(PSODARL,"DRUG_IEN")=$P(PSODARZ,"^",6)
.S PSODAR1(PSODARL,"DRUG_NM")=$P($G(^PSDRUG($P(PSODARZ,"^",6),0)),"^")
.I PSODAR1(PSODARL,"DRUG_NM")="",PSODAR1("OI") S PSODAR1(PSODARL,"DRUG_NM")=$P($G(^PS(50.7,PSODAR1("OI"),0)),"^")
.S PSODAR1(PSODARL,"RX_NUM")="O;"_PSODARX_";PROSPECTIVE;"_PSODARL
.S PSODAR6=$G(^PSRX(PSODARX,6,PSODARL,0))
.S PSODAR2(PSODARL,"CONJ")=$P(PSODAR6,"^",6)
.S PSODAR2(PSODARL,"DRATE")=$P(PSODAR6,"^",5)
.D DOSE
.I $P(PSODAR6,"^",8)'="" S PSODAR2(PSODARL,"SCHEDULE")=$P(PSODAR6,"^",8)
.;S PSODAR1(PSODARL,"DURATION")=1
.;S PSODAR1(PSODARL,"DURATION_RT")="DAY"
.I $P(PSODAR6,"^",7) S PSODAR1(PSODARL,"ROUTE")=$P($$MRT^PSSDSAPI($P(PSODAR6,"^",7)),"^",2)
.S PSODARCT=1
I 'PSODARCT Q
S PSODAR2("CONTEXT")="OP-UD" ;; cmf - Mocha 2.1/PSO*402 change
D DOSE^PSSDSAPD(.PSODARTX,$P(PSODARZ,"^",2),.PSODAR2,.PSODAR1)
Q
;
;
DOSE ;
N PSODARUN,PSODARUX,PSODARFL
S PSODARFL=0
I $P(PSODAR6,"^"),$P(PSODAR6,"^",2),$P(PSODAR6,"^",3) D
.S PSODARR(PSODARL,"DOSE_AMT")=$P(PSODAR6,"^")
.S PSODARUN=$P($G(^PS(50.607,+$P(PSODAR6,"^",3),0)),"^")
.Q:$G(PSODARUN)=""
.S PSODARUX=$$UNIT^PSSDSAPI(PSODARUN)
.Q:$G(PSODARUX)=""
.S PSODAR1(PSODARL,"DOSE_AMT")=$P(PSODAR6,"^")
.S PSODAR1(PSODARL,"DOSE_UNIT")=PSODARUX
.S PSODARFL=1
Q:PSODARFL
S PSODAR2(PSODARL,"DO")=$P(PSODAR6,"^")
Q
;
PEN(PSOSARTX,PSOSARX) ;Pending Order
;Use PSOSAR
;This is currently not being called, if ever called, DRUG_NM and OI and PACKAGE
N PSOSAR1,PSOSAR2,PSOSARZ,PSOSARL,PSOSARCT,PSOSAR6,PSOSAR7
S PSOSARZ=$G(^PS(52.41,PSOSARX,0))
I '$P(PSOSARZ,"^",2)!('$P(PSOSARZ,"^",9)) Q
S PSOSARCT=0
F PSOSARL=0:0 S PSOSARL=$O(^PS(52.41,PSOSARX,1,PSOSARL)) Q:'PSOSARL!(PSOSARCT) D
.S PSOSAR1(PSOSARL,"RX_NUM")=PSOSARX
.S PSOSAR1(PSOSARL,"DRUG_IEN")=$P(PSOSARZ,"^",9)
.S PSOSAR6=$G(^PS(52.41,PSOSARX,1,PSOSARL,1))
.S PSOSAR7=$G(^PS(52.41,PSOSARX,1,PSOSARL,2))
.D PDOSE
.I $P(PSOSAR6,"^")'="" S PSOSAR1(PSOSARL,"FREQ")=$$FRQ^PSSDSAPI($P(PSOSAR6,"^"),,"O")
.S PSOSAR1(PSOSARL,"DURATION")=1
.S PSOSAR1(PSOSARL,"DURATION_RT")="DAY"
.I $P(PSOSAR6,"^",8) S PSOSAR1(PSOSARL,"ROUTE")=$P($$MRT^PSSDSAPI($P(PSOSAR6,"^",8)),"^",2)
.S PSOSARCT=1
I 'PSOSARCT Q
S PSOSAR2("CONTEXT")="OP-UD" ;; cmf - Mocha 2.1/PSO*402 change
D DOSE^PSSDSAPD(PSOSARTX,$P(PSOSARZ,"^",2),.PSOSAR2,.PSOSAR1)
Q
;
;
PDOSE ;
N PSOSARUN,PSOSARUX,PSOSARFL
S PSOSARFL=0
I $P(PSOSAR7,"^"),$P(PSOSAR7,"^",2),$P(PSOSAR6,"^",9) D
.S PSOSARR(PSOSARL,"DOSE_AMT")=$P(PSOSAR7,"^")
.S PSOSARUN=$P($G(^PS(50.607,+$P(PSOSAR6,"^",9),0)),"^")
.Q:$G(PSOSARUN)=""
.S PSOSARUX=$$UNIT^PSSDSAPI(PSOSARUN)
.Q:$G(PSOSARUX)=""
.S PSOSAR1(PSOSARL,"DOSE_AMT")=$P(PSOSAR7,"^")
.S PSOSAR1(PSOSARL,"DOSE_UNIT")=PSOSARUX
.S PSOSARFL=1
Q:PSOSARFL
S PSOSAR2(PSOSARL,"DO")=$P(PSOSAR7,"^")
Q
;
;
FIN(PSOXARTX,PSOXARX,PSOXARY) ;
;Set up variables and make Dose Call
;Assumes PSODFN is defined
;Don't set arrays that are passed in
;use PSOXAR
N PSOXAR1,PSOXAR2,PSOXARL1,PSOXARL2
I '$G(PSODFN)!('$G(PSOXARY("IEN"))) Q
S PSOXAR1("PACKAGE")="O"
S PSOXAR1("OI")=$P($G(^PSDRUG(PSOXARY("IEN"),2)),"^")
F PSOXARL1=0:0 S PSOXARL1=$O(PSOXARX("DOSE",PSOXARL1)) Q:'PSOXARL1 D
.S PSOXAR1(PSOXARL1,"RX_NUM")="O;1;PROSPECTIVE;"_PSOXARL1
.S PSOXAR1(PSOXARL1,"DRUG_IEN")=PSOXARY("IEN")
.S PSOXAR1(PSOXARL1,"DRUG_NM")=$P($G(^PSDRUG(PSOXARY("IEN"),0)),"^")
.I PSOXAR1(PSOXARL1,"DRUG_NM")="",PSOXAR1("OI") S PSOXAR1(PSOXARL1,"DRUG_NM")=$P($G(^PS(50.7,PSOXAR1("OI"),0)),"^")
.S PSOXAR2(PSOXARL1,"CONJ")=$G(PSOXARX("CONJUNCTION",PSOXARL1))
.S PSOXAR2(PSOXARL1,"DRATE")=$G(PSOXARX("DURATION",PSOXARL1))
.D FDOSE
.I $G(PSOXARX("SCHEDULE",PSOXARL1))'="" S PSOXAR2(PSOXARL1,"SCHEDULE")=PSOXARX("SCHEDULE",PSOXARL1)
.;S PSOXAR1(PSOXARL1,"DURATION")=1
.;S PSOXAR1(PSOXARL1,"DURATION_RT")="DAY"
.I $G(PSOXARX("ROUTE",PSOXARL1)) S PSOXAR1(PSOXARL1,"ROUTE")=$P($$MRT^PSSDSAPI(PSOXARX("ROUTE",PSOXARL1)),"^",2)
S PSOXAR2("CONTEXT")="OP-UD" ;; cmf - Mocha 2.1/PSO*402 change
D DOSE^PSSDSAPD(.PSOXARTX,PSODFN,.PSOXAR2,.PSOXAR1)
Q
;
FDOSE ;
N PSOXARUN,PSOXARUX,PSOXARFL
S PSOXARFL=0
I $G(PSOXARX("DOSE",PSOXARL1)),$G(PSOXARX("UNITS",PSOXARL1)),$G(PSOXARX("DOSE ORDERED",PSOXARL1)) D
.S PSOXARUN=$P($G(^PS(50.607,+$G(PSOXARX("UNITS",PSOXARL1)),0)),"^")
.Q:PSOXARUN=""
.S PSOXARUX=$$UNIT^PSSDSAPI(PSOXARUN)
.Q:$G(PSOXARUX)=""
.S PSOXAR1(PSOXARL1,"DOSE_AMT")=PSOXARX("DOSE",PSOXARL1)
.S PSOXAR1(PSOXARL1,"DOSE_UNIT")=PSOXARUX
.S PSOXARFL=1
Q:PSOXARFL
S PSOXAR2(PSOXARL1,"DO")=$G(PSOXARX("DOSE",PSOXARL1))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODOSCL 5500 printed Apr 09, 2024@21:36:28 Page 2
PSODOSCL ;BIR/RTR-Dose Call Utility Routine ;10/07/08
+1 ;;7.0;OUTPATIENT PHARMACY;**251,402**;DEC 1997;Build 8
+2 ;
+3 ;Reference to ^PSDRUG( supported by DBIA 221
+4 ;Reference to ^PS(50.7 supported by DBIA 2223
+5 ;External reference to $$FRQ^PSSDSAPI supported by DBIA 5425
+6 ;External reference to $$MRT^PSSDSAPI supported by DBIA 5425
+7 ;External reference to $$UNIT^PSSDSAPI supported by DBIA 5425
+8 ;External reference to $$DOSE^PSSDSAPD supported by DBIA 5426
+9 ;PSODARTX = Literal Subscript
+10 ;PSODAR = Internal Prescription Number from Prescription (#52) File
+11 ;
RX(PSODARTX,PSODARX) ;
+1 ;use Psodar
+2 NEW PSODAR1,PSODAR2,PSODARZ,PSODARL,PSODARCT,PSODAR6
+3 SET PSODARZ=$GET(^PSRX(PSODARX,0))
+4 IF '$PIECE(PSODARZ,"^",2)!('$PIECE(PSODARZ,"^",6))
QUIT
+5 SET PSODAR1("PACKAGE")="O"
+6 SET PSODAR1("OI")=$PIECE($GET(^PSDRUG($PIECE(PSODARZ,"^",6),2)),"^")
+7 SET PSODARCT=0
+8 FOR PSODARL=0:0
SET PSODARL=$ORDER(^PSRX(PSODARX,6,PSODARL))
if 'PSODARL
QUIT
Begin DoDot:1
+9 SET PSODAR1(PSODARL,"DRUG_IEN")=$PIECE(PSODARZ,"^",6)
+10 SET PSODAR1(PSODARL,"DRUG_NM")=$PIECE($GET(^PSDRUG($PIECE(PSODARZ,"^",6),0)),"^")
+11 IF PSODAR1(PSODARL,"DRUG_NM")=""
IF PSODAR1("OI")
SET PSODAR1(PSODARL,"DRUG_NM")=$PIECE($GET(^PS(50.7,PSODAR1("OI"),0)),"^")
+12 SET PSODAR1(PSODARL,"RX_NUM")="O;"_PSODARX_";PROSPECTIVE;"_PSODARL
+13 SET PSODAR6=$GET(^PSRX(PSODARX,6,PSODARL,0))
+14 SET PSODAR2(PSODARL,"CONJ")=$PIECE(PSODAR6,"^",6)
+15 SET PSODAR2(PSODARL,"DRATE")=$PIECE(PSODAR6,"^",5)
+16 DO DOSE
+17 IF $PIECE(PSODAR6,"^",8)'=""
SET PSODAR2(PSODARL,"SCHEDULE")=$PIECE(PSODAR6,"^",8)
+18 ;S PSODAR1(PSODARL,"DURATION")=1
+19 ;S PSODAR1(PSODARL,"DURATION_RT")="DAY"
+20 IF $PIECE(PSODAR6,"^",7)
SET PSODAR1(PSODARL,"ROUTE")=$PIECE($$MRT^PSSDSAPI($PIECE(PSODAR6,"^",7)),"^",2)
+21 SET PSODARCT=1
End DoDot:1
+22 IF 'PSODARCT
QUIT
+23 ;; cmf - Mocha 2.1/PSO*402 change
SET PSODAR2("CONTEXT")="OP-UD"
+24 DO DOSE^PSSDSAPD(.PSODARTX,$PIECE(PSODARZ,"^",2),.PSODAR2,.PSODAR1)
+25 QUIT
+26 ;
+27 ;
DOSE ;
+1 NEW PSODARUN,PSODARUX,PSODARFL
+2 SET PSODARFL=0
+3 IF $PIECE(PSODAR6,"^")
IF $PIECE(PSODAR6,"^",2)
IF $PIECE(PSODAR6,"^",3)
Begin DoDot:1
+4 SET PSODARR(PSODARL,"DOSE_AMT")=$PIECE(PSODAR6,"^")
+5 SET PSODARUN=$PIECE($GET(^PS(50.607,+$PIECE(PSODAR6,"^",3),0)),"^")
+6 if $GET(PSODARUN)=""
QUIT
+7 SET PSODARUX=$$UNIT^PSSDSAPI(PSODARUN)
+8 if $GET(PSODARUX)=""
QUIT
+9 SET PSODAR1(PSODARL,"DOSE_AMT")=$PIECE(PSODAR6,"^")
+10 SET PSODAR1(PSODARL,"DOSE_UNIT")=PSODARUX
+11 SET PSODARFL=1
End DoDot:1
+12 if PSODARFL
QUIT
+13 SET PSODAR2(PSODARL,"DO")=$PIECE(PSODAR6,"^")
+14 QUIT
+15 ;
PEN(PSOSARTX,PSOSARX) ;Pending Order
+1 ;Use PSOSAR
+2 ;This is currently not being called, if ever called, DRUG_NM and OI and PACKAGE
+3 NEW PSOSAR1,PSOSAR2,PSOSARZ,PSOSARL,PSOSARCT,PSOSAR6,PSOSAR7
+4 SET PSOSARZ=$GET(^PS(52.41,PSOSARX,0))
+5 IF '$PIECE(PSOSARZ,"^",2)!('$PIECE(PSOSARZ,"^",9))
QUIT
+6 SET PSOSARCT=0
+7 FOR PSOSARL=0:0
SET PSOSARL=$ORDER(^PS(52.41,PSOSARX,1,PSOSARL))
if 'PSOSARL!(PSOSARCT)
QUIT
Begin DoDot:1
+8 SET PSOSAR1(PSOSARL,"RX_NUM")=PSOSARX
+9 SET PSOSAR1(PSOSARL,"DRUG_IEN")=$PIECE(PSOSARZ,"^",9)
+10 SET PSOSAR6=$GET(^PS(52.41,PSOSARX,1,PSOSARL,1))
+11 SET PSOSAR7=$GET(^PS(52.41,PSOSARX,1,PSOSARL,2))
+12 DO PDOSE
+13 IF $PIECE(PSOSAR6,"^")'=""
SET PSOSAR1(PSOSARL,"FREQ")=$$FRQ^PSSDSAPI($PIECE(PSOSAR6,"^"),,"O")
+14 SET PSOSAR1(PSOSARL,"DURATION")=1
+15 SET PSOSAR1(PSOSARL,"DURATION_RT")="DAY"
+16 IF $PIECE(PSOSAR6,"^",8)
SET PSOSAR1(PSOSARL,"ROUTE")=$PIECE($$MRT^PSSDSAPI($PIECE(PSOSAR6,"^",8)),"^",2)
+17 SET PSOSARCT=1
End DoDot:1
+18 IF 'PSOSARCT
QUIT
+19 ;; cmf - Mocha 2.1/PSO*402 change
SET PSOSAR2("CONTEXT")="OP-UD"
+20 DO DOSE^PSSDSAPD(PSOSARTX,$PIECE(PSOSARZ,"^",2),.PSOSAR2,.PSOSAR1)
+21 QUIT
+22 ;
+23 ;
PDOSE ;
+1 NEW PSOSARUN,PSOSARUX,PSOSARFL
+2 SET PSOSARFL=0
+3 IF $PIECE(PSOSAR7,"^")
IF $PIECE(PSOSAR7,"^",2)
IF $PIECE(PSOSAR6,"^",9)
Begin DoDot:1
+4 SET PSOSARR(PSOSARL,"DOSE_AMT")=$PIECE(PSOSAR7,"^")
+5 SET PSOSARUN=$PIECE($GET(^PS(50.607,+$PIECE(PSOSAR6,"^",9),0)),"^")
+6 if $GET(PSOSARUN)=""
QUIT
+7 SET PSOSARUX=$$UNIT^PSSDSAPI(PSOSARUN)
+8 if $GET(PSOSARUX)=""
QUIT
+9 SET PSOSAR1(PSOSARL,"DOSE_AMT")=$PIECE(PSOSAR7,"^")
+10 SET PSOSAR1(PSOSARL,"DOSE_UNIT")=PSOSARUX
+11 SET PSOSARFL=1
End DoDot:1
+12 if PSOSARFL
QUIT
+13 SET PSOSAR2(PSOSARL,"DO")=$PIECE(PSOSAR7,"^")
+14 QUIT
+15 ;
+16 ;
FIN(PSOXARTX,PSOXARX,PSOXARY) ;
+1 ;Set up variables and make Dose Call
+2 ;Assumes PSODFN is defined
+3 ;Don't set arrays that are passed in
+4 ;use PSOXAR
+5 NEW PSOXAR1,PSOXAR2,PSOXARL1,PSOXARL2
+6 IF '$GET(PSODFN)!('$GET(PSOXARY("IEN")))
QUIT
+7 SET PSOXAR1("PACKAGE")="O"
+8 SET PSOXAR1("OI")=$PIECE($GET(^PSDRUG(PSOXARY("IEN"),2)),"^")
+9 FOR PSOXARL1=0:0
SET PSOXARL1=$ORDER(PSOXARX("DOSE",PSOXARL1))
if 'PSOXARL1
QUIT
Begin DoDot:1
+10 SET PSOXAR1(PSOXARL1,"RX_NUM")="O;1;PROSPECTIVE;"_PSOXARL1
+11 SET PSOXAR1(PSOXARL1,"DRUG_IEN")=PSOXARY("IEN")
+12 SET PSOXAR1(PSOXARL1,"DRUG_NM")=$PIECE($GET(^PSDRUG(PSOXARY("IEN"),0)),"^")
+13 IF PSOXAR1(PSOXARL1,"DRUG_NM")=""
IF PSOXAR1("OI")
SET PSOXAR1(PSOXARL1,"DRUG_NM")=$PIECE($GET(^PS(50.7,PSOXAR1("OI"),0)),"^")
+14 SET PSOXAR2(PSOXARL1,"CONJ")=$GET(PSOXARX("CONJUNCTION",PSOXARL1))
+15 SET PSOXAR2(PSOXARL1,"DRATE")=$GET(PSOXARX("DURATION",PSOXARL1))
+16 DO FDOSE
+17 IF $GET(PSOXARX("SCHEDULE",PSOXARL1))'=""
SET PSOXAR2(PSOXARL1,"SCHEDULE")=PSOXARX("SCHEDULE",PSOXARL1)
+18 ;S PSOXAR1(PSOXARL1,"DURATION")=1
+19 ;S PSOXAR1(PSOXARL1,"DURATION_RT")="DAY"
+20 IF $GET(PSOXARX("ROUTE",PSOXARL1))
SET PSOXAR1(PSOXARL1,"ROUTE")=$PIECE($$MRT^PSSDSAPI(PSOXARX("ROUTE",PSOXARL1)),"^",2)
End DoDot:1
+21 ;; cmf - Mocha 2.1/PSO*402 change
SET PSOXAR2("CONTEXT")="OP-UD"
+22 DO DOSE^PSSDSAPD(.PSOXARTX,PSODFN,.PSOXAR2,.PSOXAR1)
+23 QUIT
+24 ;
FDOSE ;
+1 NEW PSOXARUN,PSOXARUX,PSOXARFL
+2 SET PSOXARFL=0
+3 IF $GET(PSOXARX("DOSE",PSOXARL1))
IF $GET(PSOXARX("UNITS",PSOXARL1))
IF $GET(PSOXARX("DOSE ORDERED",PSOXARL1))
Begin DoDot:1
+4 SET PSOXARUN=$PIECE($GET(^PS(50.607,+$GET(PSOXARX("UNITS",PSOXARL1)),0)),"^")
+5 if PSOXARUN=""
QUIT
+6 SET PSOXARUX=$$UNIT^PSSDSAPI(PSOXARUN)
+7 if $GET(PSOXARUX)=""
QUIT
+8 SET PSOXAR1(PSOXARL1,"DOSE_AMT")=PSOXARX("DOSE",PSOXARL1)
+9 SET PSOXAR1(PSOXARL1,"DOSE_UNIT")=PSOXARUX
+10 SET PSOXARFL=1
End DoDot:1
+11 if PSOXARFL
QUIT
+12 SET PSOXAR2(PSOXARL1,"DO")=$GET(PSOXARX("DOSE",PSOXARL1))
+13 QUIT
