- 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 Feb 18, 2025@23:53:40 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