PSJ0050 ;BIR/JLC - BCMA MED LOG CONVERSION FOR PSJ*5*50;02 May 2001
;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97
;
; Reference to ^PSB(53.79 is supported by DBIA# 3370.
; Reference to ^PSDRUG is supported by DBIA# 2192.
; Reference to ^PS(51.2 is supported by DBIA# 2178.
;
Q
EN(PSJDFN,PSJORD,PSJCURR,PSJNEW) ;;
N S1,S2,ND0,ND1,DA,DR,DIE
I '$D(^PSB(53.79,"AOIP",PSJDFN,PSJCURR)) Q ;no administration entries for this orderable item for the specified patient
S S1=""
F S S1=$O(^PSB(53.79,"AOIP",PSJDFN,PSJCURR,S1)) Q:S1="" D
. S S2=""
. F S S2=$O(^PSB(53.79,"AOIP",PSJDFN,PSJCURR,S1,S2)) Q:S2="" D
. . S ND0=^PSB(53.79,S2,0),ND1=^(.1)
. . I +$P(ND1,"^")'=+PSJORD Q ;not the same order number
. . I +$P(ND0,"^",8)'=+PSJCURR Q ;not the orderable item we were expecting
. . S DIE="^PSB(53.79,",DA=S2,DR=".08////"_PSJNEW D ^DIE
Q
;
ENIVUD ;Conversion of Pending orders to set UD/IV PROMPT field in 53.1
N PSJORD,PSJOTYP,PSJCOI,PSJPDFN,PSJOI,PSJDD,PSJMR,PSJTYP
S PSJPDFN=0 F S PSJPDFN=$O(^PS(53.1,"AS","P",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 F S PSJORD=$O(^PS(53.1,"AS","P",PSJPDFN,PSJORD)) Q:'PSJORD D
.S PSJOI=+$G(^PS(53.1,PSJORD,.2)),PSJDD=+$G(^PS(53.1,PSJORD,1,1,0)),PSJMR=$P($G(^PS(53.1,PSJORD,0)),U,3),PSJTYP=$P($G(^(0)),U,4) Q:PSJTYP="F"
.S:PSJDD>0 PSJPRO=$$ORTYP(PSJMR,PSJDD) S:PSJDD=0 PSJPRO=$$TRYAGAIN(PSJMR,PSJOI)
.S $P(^PS(53.1,PSJORD,0),U,13)=PSJPRO
Q
ORTYP(MDRT,DDRG) ;Entry point to determine order type for 53.1
;MDRT=Med Route from 51.2, DDRG=Dispense Drug
Q:'+MDRT Q:'+DDRG
S ORTYP=""
I $P(^PSDRUG(DDRG,2),"^",3)'["I",$P(^PSDRUG(DDRG,2),"^",3)'["U" S ORTYP="" Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)["I",$P(^PSDRUG(DDRG,2),"^",3)'["U",$P(^PS(51.2,MDRT,0),"^",6)=1 S ORTYP="" Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)'["I",$P(^PS(51.2,MDRT,0),"^",6)=1 S ORTYP=1 Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)["I",$P(^PS(51.2,MDRT,0),"^",6)=1 S ORTYP=1 Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)["I",$P(^PSDRUG(DDRG,2),"^",3)'["U",$P(^PS(51.2,MDRT,0),"^",6)'=1 S ORTYP=1 Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)["U",$P(^PSDRUG(DDRG,2),"^",3)'["I",$P(^PS(51.2,MDRT,0),"^",6)'=1 S ORTYP="" Q ORTYP
I $P(^PSDRUG(DDRG,2),"^",3)["U",$P(^PS(51.2,MDRT,0),"^",6)'=1 S ORTYP=1 Q ORTYP
S ORTYP="" Q ORTYP
;
TRYAGAIN(MDRT,OI) ;
;MDRT=Med Route from 51.2, OI=Orderable Item
Q:'+MDRT Q:'+OI
S ORTYP=""
N DDRG S DDRG=0 F S DDRG=$O(^PSDRUG("ASP",OI,DDRG)) Q:'DDRG S ORTYP=$$ORTYP(MDRT,DDRG) Q:ORTYP]""
Q ORTYP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ0050 2487 printed Oct 16, 2024@18:06:10 Page 2
PSJ0050 ;BIR/JLC - BCMA MED LOG CONVERSION FOR PSJ*5*50;02 May 2001
+1 ;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97
+2 ;
+3 ; Reference to ^PSB(53.79 is supported by DBIA# 3370.
+4 ; Reference to ^PSDRUG is supported by DBIA# 2192.
+5 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
+6 ;
+7 QUIT
EN(PSJDFN,PSJORD,PSJCURR,PSJNEW) ;;
+1 NEW S1,S2,ND0,ND1,DA,DR,DIE
+2 ;no administration entries for this orderable item for the specified patient
IF '$DATA(^PSB(53.79,"AOIP",PSJDFN,PSJCURR))
QUIT
+3 SET S1=""
+4 FOR
SET S1=$ORDER(^PSB(53.79,"AOIP",PSJDFN,PSJCURR,S1))
if S1=""
QUIT
Begin DoDot:1
+5 SET S2=""
+6 FOR
SET S2=$ORDER(^PSB(53.79,"AOIP",PSJDFN,PSJCURR,S1,S2))
if S2=""
QUIT
Begin DoDot:2
+7 SET ND0=^PSB(53.79,S2,0)
SET ND1=^(.1)
+8 ;not the same order number
IF +$PIECE(ND1,"^")'=+PSJORD
QUIT
+9 ;not the orderable item we were expecting
IF +$PIECE(ND0,"^",8)'=+PSJCURR
QUIT
+10 SET DIE="^PSB(53.79,"
SET DA=S2
SET DR=".08////"_PSJNEW
DO ^DIE
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
ENIVUD ;Conversion of Pending orders to set UD/IV PROMPT field in 53.1
+1 NEW PSJORD,PSJOTYP,PSJCOI,PSJPDFN,PSJOI,PSJDD,PSJMR,PSJTYP
+2 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(53.1,"AS","P",PSJPDFN))
if 'PSJPDFN
QUIT
SET PSJORD=0
FOR
SET PSJORD=$ORDER(^PS(53.1,"AS","P",PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:1
+3 SET PSJOI=+$GET(^PS(53.1,PSJORD,.2))
SET PSJDD=+$GET(^PS(53.1,PSJORD,1,1,0))
SET PSJMR=$PIECE($GET(^PS(53.1,PSJORD,0)),U,3)
SET PSJTYP=$PIECE($GET(^(0)),U,4)
if PSJTYP="F"
QUIT
+4 if PSJDD>0
SET PSJPRO=$$ORTYP(PSJMR,PSJDD)
if PSJDD=0
SET PSJPRO=$$TRYAGAIN(PSJMR,PSJOI)
+5 SET $PIECE(^PS(53.1,PSJORD,0),U,13)=PSJPRO
End DoDot:1
+6 QUIT
ORTYP(MDRT,DDRG) ;Entry point to determine order type for 53.1
+1 ;MDRT=Med Route from 51.2, DDRG=Dispense Drug
+2 if '+MDRT
QUIT
if '+DDRG
QUIT
+3 SET ORTYP=""
+4 IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["I"
IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["U"
SET ORTYP=""
QUIT ORTYP
+5 IF $PIECE(^PSDRUG(DDRG,2),"^",3)["I"
IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["U"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)=1
SET ORTYP=""
QUIT ORTYP
+6 IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["I"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)=1
SET ORTYP=1
QUIT ORTYP
+7 IF $PIECE(^PSDRUG(DDRG,2),"^",3)["I"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)=1
SET ORTYP=1
QUIT ORTYP
+8 IF $PIECE(^PSDRUG(DDRG,2),"^",3)["I"
IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["U"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)'=1
SET ORTYP=1
QUIT ORTYP
+9 IF $PIECE(^PSDRUG(DDRG,2),"^",3)["U"
IF $PIECE(^PSDRUG(DDRG,2),"^",3)'["I"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)'=1
SET ORTYP=""
QUIT ORTYP
+10 IF $PIECE(^PSDRUG(DDRG,2),"^",3)["U"
IF $PIECE(^PS(51.2,MDRT,0),"^",6)'=1
SET ORTYP=1
QUIT ORTYP
+11 SET ORTYP=""
QUIT ORTYP
+12 ;
TRYAGAIN(MDRT,OI) ;
+1 ;MDRT=Med Route from 51.2, OI=Orderable Item
+2 if '+MDRT
QUIT
if '+OI
QUIT
+3 SET ORTYP=""
+4 NEW DDRG
SET DDRG=0
FOR
SET DDRG=$ORDER(^PSDRUG("ASP",OI,DDRG))
if 'DDRG
QUIT
SET ORTYP=$$ORTYP(MDRT,DDRG)
if ORTYP]""
QUIT
+5 QUIT ORTYP
