- PSJORAPI ;BIR/LDT-API utility routine ;7/8/00
- ;;5.0; INPATIENT MEDICATIONS ;**48**;16 DEC 1997
- ;
- ; Reference to ^PSDRUG is supported by DBIA 2192.
- ; Reference to ^PS(52.6 is supported by DBIA 1231.
- ; Reference to ^PS(52.7 is supported by DBIA 2173.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ;
- EN(PSJB,PSJE,PSJX,PSJDT,PSJN) ;
- ;PSJB - begin date
- ;PSJE - end date
- ;PSJX - medication array
- ;PSJDT - fill date (not used by Inaptient)
- ;PSJN - node subscript
- ;
- N PSJRD,PSJDRG,PSJND,PSJPDFN,PSJCX,PSJMED1,PSJMED2,PSJDNM,PSJBEG,PSJEND,PSJSTRT,PSJSTP
- Q:'$G(PSJB)!('$G(PSJE))
- Q:$G(PSJN)=""
- K ^TMP(PSJN,$J),^TMP($J,"PSJCT")
- UD ;Check for Unit Dose orders
- N PSJND2,PSJORD,PSJDDRG
- S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
- F S PSJBEG=$O(^PS(55,"AUDS",PSJBEG)) Q:'PSJBEG!(PSJBEG>PSJEND) S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
- . S PSJORD=0 F S PSJORD=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
- .. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4)
- .. S PSJDDRG=0 F S PSJDDRG=$O(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG)) Q:'PSJDDRG S PSJDRG=+$G(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG,0)),PSJND=+$G(^PSDRUG(+PSJDRG,"ND")),PSJDNM=$P($G(^(0)),"^") D MED
- IV ;Check for IV orders
- N PSJND0,PSJORD,PSJDDRG,FIL,DRG,DRGTYP
- S PSJBEG=PSJB-.0001,PSJEND=PSJE+.999999
- F S PSJBEG=$O(^PS(55,"AIVS",PSJBEG)) Q:'PSJBEG!(PSJBEG>PSJEND) S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
- . S PSJORD=0 F S PSJORD=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
- .. S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND0,"^",2),PSJSTP=$P(PSJND0,"^",3)
- .. F DRGTYP="AD","SOL" F DRG=0:0 S DRG=$O(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG)) Q:'DRG D
- ... S PSJDDRG=+$G(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG,0)),FIL=$S(DRGTYP="AD":52.6,1:52.7),PSJDRG=$P($G(^PS(FIL,+PSJDDRG,0)),"^",2),PSJND=+$G(^PSDRUG(+PSJDRG,"ND")),PSJDNM=$P($G(^(0)),"^") D MED
- G END
- Q
- ;
- MED ;Check medication array for matches
- K PSJMED1,PSJMED2,PSJMED3
- I $D(PSJX(PSJDRG_";PSDRUG(")) S PSJMED1=1 D MEDS Q
- I $G(PSJND),$D(PSJX(PSJND_";PSNDF(50.6,")) S PSJMED2=1 D MEDS Q
- ;Here, add class check when ready, use PSJMED2 for NDF, default to 1 for VA Class in MEDS
- Q
- MEDS I $D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=^TMP($J,"PSJCT",PSJPDFN)+1
- I '$D(^TMP($J,"PSJCT",PSJPDFN)) S (PSJCX,^TMP($J,"PSJCT",PSJPDFN))=1
- S ^TMP(PSJN,$J,PSJPDFN,PSJCX,0)=$S($G(PSJMED1):PSJDRG_";PSDRUG(",1:$G(PSJND)_";PSNDF(50.6,")
- S ^TMP(PSJN,$J,PSJPDFN,PSJCX,1)=$G(PSJSTRT)_"^^"_$G(PSJDNM)_"^^"_$G(PSJSTP)
- Q
- END ;
- K ^TMP($J,"PSJCT")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORAPI 2667 printed Mar 13, 2025@21:13:07 Page 2
- PSJORAPI ;BIR/LDT-API utility routine ;7/8/00
- +1 ;;5.0; INPATIENT MEDICATIONS ;**48**;16 DEC 1997
- +2 ;
- +3 ; Reference to ^PSDRUG is supported by DBIA 2192.
- +4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
- +5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
- +6 ; Reference to ^PS(55 is supported by DBIA 2191.
- +7 ;
- EN(PSJB,PSJE,PSJX,PSJDT,PSJN) ;
- +1 ;PSJB - begin date
- +2 ;PSJE - end date
- +3 ;PSJX - medication array
- +4 ;PSJDT - fill date (not used by Inaptient)
- +5 ;PSJN - node subscript
- +6 ;
- +7 NEW PSJRD,PSJDRG,PSJND,PSJPDFN,PSJCX,PSJMED1,PSJMED2,PSJDNM,PSJBEG,PSJEND,PSJSTRT,PSJSTP
- +8 if '$GET(PSJB)!('$GET(PSJE))
- QUIT
- +9 if $GET(PSJN)=""
- QUIT
- +10 KILL ^TMP(PSJN,$JOB),^TMP($JOB,"PSJCT")
- UD ;Check for Unit Dose orders
- +1 NEW PSJND2,PSJORD,PSJDDRG
- +2 SET PSJBEG=PSJB-.0001
- SET PSJEND=PSJE+.999999
- +3 FOR
- SET PSJBEG=$ORDER(^PS(55,"AUDS",PSJBEG))
- if 'PSJBEG!(PSJBEG>PSJEND)
- QUIT
- SET PSJPDFN=0
- FOR
- SET PSJPDFN=$ORDER(^PS(55,"AUDS",PSJBEG,PSJPDFN))
- if 'PSJPDFN
- QUIT
- Begin DoDot:1
- +4 SET PSJORD=0
- FOR
- SET PSJORD=$ORDER(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD))
- if 'PSJORD
- QUIT
- Begin DoDot:2
- +5 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
- SET PSJSTRT=$PIECE(PSJND2,"^",2)
- SET PSJSTP=$PIECE(PSJND2,"^",4)
- +6 SET PSJDDRG=0
- FOR
- SET PSJDDRG=$ORDER(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG))
- if 'PSJDDRG
- QUIT
- SET PSJDRG=+$GET(^PS(55,PSJPDFN,5,PSJORD,1,PSJDDRG,0))
- SET PSJND=+$GET(^PSDRUG(+PSJDRG,"ND"))
- SET PSJDNM=$PIECE($GET(^(0)),"^")
- DO MED
- End DoDot:2
- End DoDot:1
- IV ;Check for IV orders
- +1 NEW PSJND0,PSJORD,PSJDDRG,FIL,DRG,DRGTYP
- +2 SET PSJBEG=PSJB-.0001
- SET PSJEND=PSJE+.999999
- +3 FOR
- SET PSJBEG=$ORDER(^PS(55,"AIVS",PSJBEG))
- if 'PSJBEG!(PSJBEG>PSJEND)
- QUIT
- SET PSJPDFN=0
- FOR
- SET PSJPDFN=$ORDER(^PS(55,"AIVS",PSJBEG,PSJPDFN))
- if 'PSJPDFN
- QUIT
- Begin DoDot:1
- +4 SET PSJORD=0
- FOR
- SET PSJORD=$ORDER(^PS(55,"AIVS",PSJBEG,PSJPDFN,PSJORD))
- if 'PSJORD
- QUIT
- Begin DoDot:2
- +5 SET PSJND0=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
- SET PSJSTRT=$PIECE(PSJND0,"^",2)
- SET PSJSTP=$PIECE(PSJND0,"^",3)
- +6 FOR DRGTYP="AD","SOL"
- FOR DRG=0:0
- SET DRG=$ORDER(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG))
- if 'DRG
- QUIT
- Begin DoDot:3
- +7 SET PSJDDRG=+$GET(^PS(55,PSJPDFN,"IV",PSJORD,DRGTYP,DRG,0))
- SET FIL=$SELECT(DRGTYP="AD":52.6,1:52.7)
- SET PSJDRG=$PIECE($GET(^PS(FIL,+PSJDDRG,0)),"^",2)
- SET PSJND=+$GET(^PSDRUG(+PSJDRG,"ND"))
- SET PSJDNM=$PIECE($GET(^(0)),"^")
- DO MED
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 GOTO END
- +9 QUIT
- +10 ;
- MED ;Check medication array for matches
- +1 KILL PSJMED1,PSJMED2,PSJMED3
- +2 IF $DATA(PSJX(PSJDRG_";PSDRUG("))
- SET PSJMED1=1
- DO MEDS
- QUIT
- +3 IF $GET(PSJND)
- IF $DATA(PSJX(PSJND_";PSNDF(50.6,"))
- SET PSJMED2=1
- DO MEDS
- QUIT
- +4 ;Here, add class check when ready, use PSJMED2 for NDF, default to 1 for VA Class in MEDS
- +5 QUIT
- MEDS IF $DATA(^TMP($JOB,"PSJCT",PSJPDFN))
- SET (PSJCX,^TMP($JOB,"PSJCT",PSJPDFN))=^TMP($JOB,"PSJCT",PSJPDFN)+1
- +1 IF '$DATA(^TMP($JOB,"PSJCT",PSJPDFN))
- SET (PSJCX,^TMP($JOB,"PSJCT",PSJPDFN))=1
- +2 SET ^TMP(PSJN,$JOB,PSJPDFN,PSJCX,0)=$SELECT($GET(PSJMED1):PSJDRG_";PSDRUG(",1:$GET(PSJND)_";PSNDF(50.6,")
- +3 SET ^TMP(PSJN,$JOB,PSJPDFN,PSJCX,1)=$GET(PSJSTRT)_"^^"_$GET(PSJDNM)_"^^"_$GET(PSJSTP)
- +4 QUIT
- END ;
- +1 KILL ^TMP($JOB,"PSJCT")
- +2 QUIT
