Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJMISC

PSJMISC.m

Go to the documentation of this file.
  1. PSJMISC ;BIR/MV - MISC. SUB-ROUTINES ;03 Aug 98 / 8:42 AM
  1. ;;5.0;INPATIENT MEDICATIONS;**181,256**;16 DEC 97;Build 34
  1. ;
  1. ; Reference to ^PS(50.7 is supported by DBIA# 2180.
  1. ; Reference to ^PS(52.6 is supported by DBIA# 1231.
  1. ; Reference to ^PS(52.7 is supported by DBIA# 2173.
  1. ; Reference to ^PS(55 is supported by DBIA# 2191.
  1. ; Reference to ^PSDRUG is supported by DBIA# 2192.
  1. ;
  1. GCN(PSJDD) ;Return GCNSEQNO for a dispense drug
  1. ;PSJDD - IEN (file #50)
  1. NEW PSJDDND,X
  1. I '+$G(PSJDD) Q ""
  1. S PSJDDND=$G(^PSDRUG(+PSJDD,"ND"))
  1. I PSJDDND="" Q ""
  1. S X=$$PROD0^PSNAPIS($P(PSJDDND,U),$P(PSJDDND,U,3))
  1. Q $P(X,U,7)
  1. GTVUID(PSJDD) ;Return the VUID for a dispense drug
  1. ;PSJDD - IEN (file #50)
  1. NEW PSJND,PSJVUID,DIC
  1. I '+$G(PSJDD) Q ""
  1. S PSJVUID=""
  1. S PSJND=$P($G(^PSDRUG(+PSJDD,"ND")),U,3)
  1. I +PSJND S PSJVUID=$$GETVUID^XTID(50.68,,PSJND_",")
  1. Q PSJVUID
  1. VAGEN(PSJDD) ;Return the VA GENERIC name
  1. ;PSJDD - IEN (file #50)
  1. NEW PSJIEN,PSJVAGEN
  1. I '+$G(PSJDD) Q ""
  1. S PSJIEN=+$G(^PSDRUG(PSJDD,"ND"))
  1. D ZERO^PSN50P6(PSJIEN,,,,"PSJVAGEN")
  1. S PSJVAGEN=$G(^TMP($J,"PSJVAGEN",PSJIEN,.01))
  1. K ^TMP($J,"PSJVAGEN")
  1. Q PSJVAGEN
  1. ;
  1. GENVUID(PSJVUID) ;Return the VA GENERIC name
  1. ;PSJVUID - #50.68
  1. ;PSJRDIID - Array returning from ^XTID call
  1. ;PSJNDF - #50.68 ien
  1. ;GETIREF^XTID - will not return the .01 name if DIC is defined.
  1. I '+$G(PSJVUID) Q ""
  1. NEW PSJNDF,PSJVAGEN,DIC
  1. K PSJRDIID
  1. S PSJVAGEN=""
  1. D GETIREF^XTID("50.68",".01",PSJVUID,"PSJRDIID")
  1. S PSJNDF=$O(PSJRDIID(50.68,.01,""))
  1. K PSJRDIID
  1. I +PSJNDF D
  1. . D DATA^PSN50P68(+PSJNDF,,"PSJNDF")
  1. . S PSJVAGEN=$P($G(^TMP($J,"PSJNDF",+PSJNDF,.05)),U,2)
  1. K ^TMP($J,"PSJNDF")
  1. Q PSJVAGEN
  1. ;
  1. CLASS(PSJDD) ;Return the VA CLASS
  1. Q:'+$G(PSJDD) ""
  1. NEW PSJCLASS
  1. S PSJCLASS=$P($G(^PSDRUG(+PSJDD,0)),U,2)
  1. Q PSJCLASS
  1. ;
  1. PREMIX(X) ;Check if the solution is flag as a Pre-mix
  1. ;X - ien from 52.7
  1. ;Return 0 if not flag as premix.
  1. I '+$G(X) Q 0
  1. Q +$P($G(^PS(52.7,+X,0)),U,14)
  1. ;
  1. IVDDRG(PSIVAS,PSJIEN) ;Return corresponding dispense drug IEN for ad/sol
  1. ;PSJIEN - ien from 52.6 or 52.7
  1. ;PSIVAS - "AD" or "SOL"
  1. NEW DDRUG
  1. I PSIVAS="AD" S DDRUG=$P($G(^PS(52.6,+PSJIEN,0)),U,2)
  1. I PSIVAS="SOL" S DDRUG=$P($G(^PS(52.7,+PSJIEN,0)),U,2)
  1. Q DDRUG
  1. ;
  1. WRITE(X,DIWL,DIWR) ;Start a new line before writing
  1. NEW DN
  1. I '$G(DIWL) S DIWL=1
  1. I '$G(DIWR) S DIWR=75
  1. K ^UTILITY($J,"W") D ^DIWP D ^DIWW
  1. Q
  1. ;
  1. MYWRITE(X,DIWL,DIWR) ;Continue writing on the same line
  1. NEW DN,PSJCNT
  1. I '$G(DIWL) S DIWL=1
  1. I '$G(DIWR) S DIWR=75
  1. K ^UTILITY($J,"W") D ^DIWP
  1. F PSJCNT=0:0 S PSJCNT=$O(^UTILITY($J,"W",DIWL,PSJCNT)) Q:'PSJCNT W:PSJCNT'=1 ! W ?DIWL,^UTILITY($J,"W",DIWL,PSJCNT,0)
  1. Q
  1. ;
  1. COMPARE(DRG,TMPDRG,PSJNPRMX) ;
  1. ;PSJNPRMX is set to consider non-premix solution.
  1. ;Compare the DRG array if it has changed
  1. ;Returning 1 will cause OC to be performed due to add/sol changes or new OE
  1. I '$D(DRG) Q 0
  1. I $D(DRG),('$D(TMPDRG)) Q 1
  1. NEW PSJDIFF,PSJX,X
  1. S PSJDIFF=0
  1. F X=0:0 S X=$O(DRG("AD",X)) Q:'X!PSJDIFF S PSJX=DRG("AD",X) D
  1. . I DRG("AD",X)'=$G(TMPDRG("AD",X)) S PSJDIFF=1 Q
  1. I PSJDIFF Q 1
  1. F X=0:0 S X=$O(DRG("SOL",X)) Q:'X!PSJDIFF S PSJX=DRG("SOL",X) D
  1. . I '+$G(PSJNPRMX),'$$PREMIX(+PSJX) Q
  1. . I DRG("SOL",X)'=$G(TMPDRG("SOL",X)) S PSJDIFF=1 Q
  1. I PSJDIFF Q 1
  1. F X=0:0 S X=$O(TMPDRG("AD",X)) Q:'X!PSJDIFF S PSJX=TMPDRG("AD",X) D
  1. . I TMPDRG("AD",X)'=$G(DRG("AD",X)) S PSJDIFF=1 Q
  1. I PSJDIFF Q 1
  1. F X=0:0 S X=$O(TMPDRG("SOL",X)) Q:'X!PSJDIFF S PSJX=TMPDRG("SOL",X) D
  1. . I '+$G(PSJNPRMX),'$$PREMIX(+PSJX) Q
  1. . I TMPDRG("SOL",X)'=$G(DRG("SOL",X)) S PSJDIFF=1 Q
  1. Q PSJDIFF
  1. DN(X) ;
  1. ;Return the drug name from file 50
  1. Q $P($G(^PSDRUG(+X,0)),U)
  1. OI(X) ;
  1. ;Return the Orderable name from file 50.7
  1. NEW PSJX
  1. S PSJX=$P($G(^PS(50.7,+X,0)),U)
  1. Q $S(PSJX="":"Invalid Orderable Item",1:PSJX)
  1. LINE(PSJLINE,PSJLEN) ;Display a line
  1. ;PSJLINE - type of line (ex: '-', '=")
  1. ;PSJLEN - the length of line
  1. S X="",$P(X,PSJLINE,PSJLEN)=""
  1. W X
  1. Q
  1. DD53P45() ;Return the zero node of the first dispense drug found in 53.45
  1. ;Calling routine needs to clean up PSJALLGY array.
  1. NEW PSJDD,PSJDD1,PSJDD0,X,PSJX,PSGDT,%
  1. D NOW^%DTC S PSGDT=%
  1. S PSJDD="",PSJDD1=""
  1. I '+$G(PSJSYSP) Q ""
  1. F X=0:0 S X=$O(^PS(53.45,+PSJSYSP,2,X)) Q:'+X D
  1. . S PSJDD0=$G(^PS(53.45,PSJSYSP,2,X,0))
  1. . S PSJX=$P(PSJDD0,U,3) I PSJX]"",(PSJX'>$G(PSGDT)) S PSJDD0="" Q
  1. . S PSJDD=+PSJDD0
  1. . S PSJX=$S('$D(^PSDRUG(+PSJDD,0)):1,$P($G(^(2)),U,3)'["U":1,$G(^("I"))="":0,1:^("I")'>$G(PSGDT))
  1. . I PSJX S PSJDD0="",PSJDD="" Q
  1. . S PSJALLGY(PSJDD)=""
  1. . S:PSJDD1="" PSJDD1=PSJDD0
  1. Q $G(PSJDD1)
  1. RETQUIT() ;
  1. ;Return 1 If enter "^"
  1. NEW DIR,DIROUT,DTOUT,DUOUT,PSJQUIT
  1. S PSJQUIT=0
  1. S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
  1. S DIR("?")="Enter '^' to quit or any keys to continue"
  1. D ^DIR
  1. I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S PSJQUIT=1
  1. Q PSJQUIT
  1. PAUSE(PSJFIRST,PSJLAST) ;
  1. ;PSJFIRST - Print a blank line before the pause prompt
  1. ;PSJLAST - Print a blank line after the pause prompt
  1. K DIR W:+$G(PSJFIRST) ! S DIR(0)="EA",DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue..." D ^DIR W:+$G(PSJLAST) !
  1. Q
  1. PAUSE1() ;Allow "^"
  1. ;Return 0 if X=""
  1. ;Return 1 if X="^"
  1. ;Return 2 if Not null or "^"
  1. NEW DIR,DIRUT,DUOUT,X
  1. K DIR S DIR("A")="Press RETURN to continue or ""^"" to display the next Monograph or ""^^"" to Exit"
  1. S DIR("?")="Enter ""^"" to go to next Monograph, ""^^"" to exit the Monograph display."
  1. S DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X"
  1. D ^DIR
  1. I X="" Q 0
  1. I X="^" Q 1
  1. Q 2
  1. ONCALL(PSJSCH,PSJSTYPE) ;
  1. ; PSJSCH = Admin Schedule
  1. ; PSJSTYPE = schedule type (optional)
  1. ; Returns 0 = Not an "ON CALL" schedule.
  1. ; 1 = For schedule ="ON CALL" or schedule type = "OC".
  1. Q:$G(PSJSTYPE)="OC" 1
  1. Q:$G(PSJSCH)="" 0
  1. I PSJSCH="ON CALL"!(PSJSCH="ONCALL")!(PSJSCH="ON-CALL") Q 1
  1. Q 0
  1. TMPDRG(DFN,ON,TMPDRG) ;Set TMPDRG array from the order in 55
  1. ;ON - IV order #
  1. NEW DRGT,FIL,Y,ND,DRG,DRGI
  1. Q:'+$G(ON)
  1. F DRGT="AD","SOL" S FIL=$S(DRGT="AD":52.6,1:52.7) F Y=0:0 S Y=$O(^PS(55,DFN,"IV",+ON,DRGT,Y)) Q:'Y D
  1. .; naked ref below refers to line above
  1. .S DRG=$G(^(Y,0)),ND=$G(^PS(FIL,+DRG,0)),(DRGI,TMPDRG(DRGT,0))=$G(TMPDRG(DRGT,0))+1
  1. .S TMPDRG(DRGT,+DRGI)=+DRG_U_$P(ND,U)_U_$P(DRG,U,2)_U_$P(DRG,U,3)_U_$P(ND,U,13)_U_$P(ND,U,11)
  1. Q
  1. TMPDRG1(DFN,ON,TMPDRG) ;Set TMPDRG array from the order in 53.1
  1. ;ON - IV order #
  1. NEW DRGT,FIL,Y,ND,DRG,DRGI
  1. Q:'+$G(ON)
  1. I $P(^PS(53.1,+ON,0),U,15)'=DFN Q
  1. F DRGT="AD","SOL" S FIL=$S(DRGT="AD":52.6,1:52.7) F Y=0:0 S Y=$O(^PS(53.1,+ON,DRGT,Y)) Q:'Y D
  1. .; naked ref below refers to line above
  1. .S DRG=$G(^(Y,0)),ND=$G(^PS(FIL,+DRG,0)),(DRGI,TMPDRG(DRGT,0))=$G(TMPDRG(DRGT,0))+1
  1. .S TMPDRG(DRGT,+DRGI)=+DRG_U_$P(ND,U)_U_$P(DRG,U,2)_U_$P(DRG,U,3)_U_$P(ND,U,13)_U_$P(ND,U,11)
  1. Q
  1. INFRATE(DFN,ON,PSJIR,PSJDTYP) ;Check if the infusion rate has changed
  1. ;ON - ON_P/V
  1. ;PSJIR - infusion rate
  1. ;PSJDTYP - IV type. Only check infusion rate on continuous IV type
  1. NEW X,PSJONIR
  1. I '$D(PSJDTYP)!(+$G(PSJDTYP)=1) Q 0
  1. I '+$G(ON) Q 0
  1. I $G(PSJIR)="" Q 0
  1. I ON["V" S X=$G(^PS(55,DFN,"IV",+ON,0)) S PSJONIR=$P(X,U,8)
  1. I ON["P" S X=$G(^PS(53.1,+ON,8)) S PSJONIR=$P(X,U,5)
  1. I PSJONIR="" Q 0
  1. I PSJIR'=PSJONIR Q 1
  1. Q 0
  1. ADDD(PSJOI) ;Return the best dispense drug IEN for giving OI from the additive file
  1. ;PSJOI - 50.7 ien
  1. ;Output - 50 ien^52.6 ien or null
  1. ;PSJLIST(S1,S2) - sort by Use for IV fluid first
  1. ; S1=1 for active DD & has GCN; 2=active DD; 3=inactive DD;
  1. ; 4=active DD & has GCN; 5=active DD;6=inactive DD; S2 - DDIEN
  1. Q:'+$G(PSJOI)
  1. NEW PSJOK,PSIVIEN,PSIVIEN0,PSJINACT,PSJDDX,PSJACTDD,PSJGCN,PSJLIST,PSJFLUID
  1. S PSJOK=0
  1. F PSIVIEN=0:0 S PSIVIEN=$O(^PS(52.6,"AOI",PSJOI,PSIVIEN)) Q:'PSIVIEN Q:PSJOK D
  1. . S PSJACTDD=1,PSJGCN=0,PSJFLUID=0
  1. . S PSJINACT=$G(^PS(52.6,PSIVIEN,"I"))
  1. . I PSJINACT]"",(PSJINACT'>DT) Q
  1. . S PSIVIEN0=$G(^PS(52.6,PSIVIEN,0))
  1. . I PSIVIEN0]"" D
  1. .. S PSJDD=+$P(PSIVIEN0,U,2)
  1. .. S PSJINACT=$G(^PSDRUG(PSJDD,"I"))
  1. .. I PSJINACT]"",(PSJINACT'>DT) S PSJACTDD=0
  1. .. I $P(PSIVIEN0,U,13) S PSJFLUID=1
  1. .. I +$$GCN^PSJMISC(PSJDD) S PSJGCN=1
  1. . I PSJFLUID D
  1. .. I PSJACTDD,PSJGCN S PSJLIST(1,PSJDD)=PSIVIEN S PSJOK=1 Q
  1. .. I PSJACTDD S PSJLIST(2,PSJDD)=PSIVIEN Q
  1. .. I PSJDD S PSJLIST(3,PSJDD)=PSIVIEN
  1. . I 'PSJFLUID D
  1. .. I PSJACTDD,PSJGCN S PSJLIST(4,PSJDD)=PSIVIEN Q
  1. .. I PSJACTDD S PSJLIST(5,PSJDD)=PSIVIEN Q
  1. .. I PSJDD S PSJLIST(6,PSJDD)=PSIVIEN
  1. I '$D(PSJLIST) Q ""
  1. S (PSJDD,PSSIEN)=0,PSJDDX=$O(PSJLIST(0))
  1. I +PSJDDX S PSJDD=$O(PSJLIST(PSJDDX,0)),PSIVIEN=PSJLIST(PSJDDX,PSJDD) Q PSJDD_U_PSIVIEN
  1. Q ""
  1. SOLDD(PSJOI,PSJVOL) ;Return the best dispense drug IEN for giving OI from the solution file
  1. ;PSJOI - 50.7 ien
  1. ;Output - 50 ien^52.7 ien or null
  1. ;PSJLIST(s1,s2) - Set the list for the drugs in specific criteria for a best drug to use for dosing check
  1. ; sort by Use for IV fluid first
  1. ; IV fluid: s1: 1 - premix, active dd & matche; 2 - premix & active dd; 3 - premix ; 4 - inactive dd
  1. ; Not IV fluid: 5 - premix, active dd & matche; 6 - premix & active dd; 7 - premix ; 8 - inactive dd; s2 - Sol ien
  1. ;note - Only select sol entries with the exact volume.
  1. Q:'+$G(PSJOI)
  1. NEW PSJOK,PSIVIEN,PSJINACT,PSJDDX,PSJACTDD,PSJGCN,PSJLIST,PSJPREMX,PSJSOL,PSJFLUID
  1. S PSJOK=0,PSJFLUID=0
  1. F PSIVIEN=0:0 S PSIVIEN=$O(^PS(52.7,"AOI",PSJOI,PSIVIEN)) Q:'PSIVIEN Q:PSJOK D
  1. . S PSJACTDD=1,PSJGCN=0,PSJPREMX=0
  1. . S PSJINACT=$G(^PS(52.7,PSIVIEN,"I"))
  1. . I PSJINACT]"",(PSJINACT'>DT) Q
  1. . ;Q if volume isn't matched
  1. . S PSJSOL=$G(^PS(52.7,PSIVIEN,0))
  1. . I +$P(PSJSOL,U,3)'=+PSJVOL Q
  1. . S PSJDD=+$P($G(^PS(52.7,+PSIVIEN,0)),U,2)
  1. . S PSJINACT=$G(^PSDRUG(PSJDD,"I"))
  1. . I PSJINACT]"",(PSJINACT'>DT) S PSJACTDD=0
  1. . I +$$GCN^PSJMISC(PSJDD) S PSJGCN=1
  1. . I +$$PREMIX^PSJMISC(PSJDD) S PSJPREMX=1
  1. . I +$P(PSJSOL,U,13) S PSJFLUID=1
  1. . I PSJFLUID D
  1. .. I PSJPREMX,PSJACTDD,PSJGCN S PSJLIST(1,PSJDD)=PSIVIEN S PSJOK=1 Q
  1. .. I PSJPREMX,PSJACTDD S PSJLIST(2,PSJDD)=PSIVIEN Q
  1. .. I PSJPREMX S PSJLIST(3,PSJDD)=PSIVIEN Q
  1. .. I PSJDD S PSJLIST(4,PSJDD)=PSIVIEN
  1. . I 'PSJFLUID D
  1. .. I PSJPREMX,PSJACTDD,PSJGCN S PSJLIST(5,PSJDD)=PSIVIEN Q
  1. .. I PSJPREMX,PSJACTDD S PSJLIST(6,PSJDD)=PSIVIEN Q
  1. .. I PSJPREMX S PSJLIST(7,PSJDD)=PSIVIEN Q
  1. .. I PSJDD S PSJLIST(8,PSJDD)=PSIVIEN
  1. I '$D(PSJLIST) Q ""
  1. S (PSJDD,PSSIEN)=0,PSJDDX=$O(PSJLIST(0))
  1. I +PSJDDX S PSJDD=$O(PSJLIST(PSJDDX,0)),PSIVIEN=PSJLIST(PSJDDX,PSJDD) Q PSJDD_U_PSIVIEN
  1. Q ""