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

PSSUTIL1.m

Go to the documentation of this file.
  1. PSSUTIL1 ;BIR/RTR-Utility routine ;08/21/00
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**38,66,69,166,189,255**;9/30/97;Build 2
  1. ;Reference to ^PS(50.607 supported by DBIA #2221
  1. ;Reference to ^PSNAPIS supported by DBIA 2531
  1. ;
  1. EN(PSSDRIEN) ;
  1. N PSSMASH,PSSMNDFS,PSSMSSTR,PSSMUNIT,PSSUNZ,PSSMA,PSSMB,PSSMA1,PSSMB1,PSSUNX,PSSMASH2,PSSMASH3,PSSNAT1,PSSNAT3,PSSNODEU
  1. I '$G(PSSDRIEN) Q "|^^^^^99PSU"
  1. S PSSMSSTR=$P($G(^PSDRUG(PSSDRIEN,"DOS")),"^"),PSSMUNIT=$P($G(^("DOS")),"^",2)
  1. S PSSNAT1=$P($G(^PSDRUG(PSSDRIEN,"ND")),"^"),PSSNAT3=$P($G(^("ND")),"^",3) I PSSNAT1,PSSNAT3 S PSSNODEU=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT3) S PSSMNDFS=$P(PSSNODEU,"^",4) S:'$G(PSSMUNIT) PSSMUNIT=$P(PSSNODEU,"^",5)
  1. S PSSUNZ=$P($G(^PS(50.607,+$G(PSSMUNIT),0)),"^")
  1. I PSSUNZ'["/" Q $S($G(PSSMSSTR)'="":$G(PSSMSSTR),$G(PSSMNDFS)'="":$G(PSSMNDFS),1:"")_"|"_"^^^"_$S($G(PSSMUNIT):$G(PSSMUNIT),1:"")_"^"_$G(PSSUNZ)_"^"_"99PSU"
  1. S PSSMASH=0
  1. I $G(PSSMSSTR),$G(PSSMNDFS),+$G(PSSMSSTR)'=+$G(PSSMNDFS) S PSSMASH=1
  1. I 'PSSMASH Q PSSMSSTR_"|"_"^^^"_$S($G(PSSMUNIT):$G(PSSMUNIT),1:"")_"^"_$G(PSSUNZ)_"^"_"99PSU"
  1. S PSSMA=$P(PSSUNZ,"/"),PSSMB=$P(PSSUNZ,"/",2),PSSMA1=+$G(PSSMA),PSSMB1=+$G(PSSMB)
  1. S PSSMASH2=PSSMSSTR/PSSMNDFS,PSSMASH3=PSSMASH2*($S($G(PSSMB1):$G(PSSMB1),1:1))
  1. S PSSUNX=$G(PSSMA)_"/"_$G(PSSMASH3)_$S('$G(PSSMB1):$G(PSSMB),1:$P(PSSMB,PSSMB1,2))
  1. Q $S($G(PSSMSSTR)'="":$G(PSSMSSTR),$G(PSSMNDFS)'="":$G(PSSMNDFS),1:"")_"|"_"^^^^"_$G(PSSUNX)_"^"_"99PSU"
  1. ;
  1. Q
  1. ;
  1. DRG(PSSDD,PSSOI,PSSPK) ;
  1. ; PSSDD - Array of Drugs
  1. ; PSSOI - Orderable Item (Pharmacy)
  1. ; PSSPK - Application Package ("O"-Outpatient;"I"-IV;"X"-Non-VA Med)
  1. ;Return active dispense drugs for package based on Orderable Item
  1. N PSSL,PSSAP,PSSIN,PSSND
  1. Q:'$G(PSSOI)
  1. I $G(PSSPK)'="O",$G(PSSPK)'="I",$G(PSSPK)'="X" Q
  1. F PSSL=0:0 S PSSL=$O(^PSDRUG("ASP",PSSOI,PSSL)) Q:'PSSL D
  1. . S PSSIN=$P($G(^PSDRUG(PSSL,"I")),"^"),PSSAP=$P($G(^(2)),"^",3)
  1. . I PSSIN,PSSIN<DT Q
  1. . S PSSND=$P($G(^PSDRUG(PSSL,"ND")),"^")
  1. . I PSSPK="O"!(PSSPK="X") D Q
  1. . . S:PSSAP[PSSPK PSSDD(PSSL_";"_PSSND)=$P($G(^PSDRUG(PSSL,0)),"^")
  1. . I PSSAP["I"!(PSSAP["U") D
  1. . . S PSSDD(PSSL_";"_PSSND)=$P($G(^PSDRUG(PSSL,0)),"^")
  1. Q
  1. ;
  1. ITEM(PSSIT,PSSDR) ;Return Orderable Item to CPRS
  1. N PSSNEW
  1. I '$G(PSSIT)!('$G(PSSDR)) Q -1
  1. I '$D(^PS(50.7,+$G(PSSIT),0))!('$D(^PSDRUG(+$G(PSSDR),0))) Q -1
  1. S PSSNEW=+$P($G(^PSDRUG(+$G(PSSDR),2)),"^")
  1. I PSSNEW,PSSNEW=$G(PSSIT) Q 0
  1. I PSSNEW,PSSNEW'=$G(PSSIT) Q 1_"^"_PSSNEW
  1. Q -1
  1. ;
  1. Q
  1. ;
  1. EN1(PSSOA,PSSOAP) ;
  1. ;Return Orderable Item Forumary Alternatives to CPRS
  1. ;PSSOA = Pharmacy Orderable Item number
  1. ;PSSOAP = "I" For Inpatient, "O" For Outpatient
  1. Q:'$G(PSSOA)
  1. I $G(PSSOAP)'="O",$G(PSSOAP)'="I" Q
  1. N PSSOAL,PSSOALD,PSSOAN,PSSOAIT,PSSOADT,PSSOAZ
  1. S PSSOAL="" F S PSSOAL=$O(^PSDRUG("ASP",PSSOA,PSSOAL)) Q:PSSOAL="" D
  1. .S PSSOALD="" F S PSSOALD=$O(^PSDRUG(PSSOAL,65,PSSOALD)) Q:PSSOALD="" D
  1. ..S PSSOAN=$P($G(^PSDRUG(PSSOAL,65,PSSOALD,0)),"^") I PSSOAN S PSSOAIT=$P($G(^PSDRUG(PSSOAN,2)),"^") D:PSSOAIT
  1. ...Q:PSSOAIT=PSSOA
  1. ...Q:$D(PSSOA(PSSOAIT))
  1. ...Q:'$D(^PS(50.7,PSSOAIT,0))!($P($G(^PS(50.7,PSSOAIT,0)),"^",12))
  1. ...Q:$P($G(^PS(50.7,PSSOAIT,0)),"^",4)&(+$P($G(^(0)),"^",4)'>DT)
  1. ...S PSSOAZ="" F S PSSOAZ=$O(^PSDRUG("ASP",PSSOAIT,PSSOAZ)) Q:PSSOAZ=""!($D(PSSOA(PSSOAIT))) D
  1. ....Q:$P($G(^PSDRUG(PSSOAZ,"I")),"^")&(+$P($G(^("I")),"^")'>DT)
  1. ....Q:$P($G(^PSDRUG(PSSOAZ,0)),"^",9)
  1. ....I $G(PSSOAP)="O" S:$P($G(^PSDRUG(PSSOAZ,2)),"^",3)["O" PSSOA(PSSOAIT)="" Q
  1. ....I $P($G(^PSDRUG(PSSOAZ,2)),"^",3)["I"!($P($G(^(2)),"^",3)["U") S PSSOA(PSSOAIT)=""
  1. Q
  1. SCH(SCH) ;Expand schedule for Outpatient order in CPRS
  1. N SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST,SCHEX
  1. S SCHEX=$G(SCH) S SQFLAG=0
  1. I $G(SCH)="" G SCHQT
  1. ;I SCH[""""!($A(SCH)=45)!(SCH?.E1C.E)!($L(SCH," ")>3)!($L(SCH)>20)!($L(SCH)<1) K SCH Q
  1. F SCLOOP=0:0 S SCLOOP=$O(^PS(51.1,"B",SCH,SCLOOP)) Q:'SCLOOP!(SQFLAG) I $P($G(^PS(51.1,SCLOOP,0)),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SQFLAG=1
  1. I SQFLAG G SCHQT
  1. I $P($G(^PS(51,"A",SCH)),"^")'="" S SCHEX=$P(^(SCH),"^") G SCHQT
  1. S SCLOOP=0 F SCLP=1:1:$L(SCH) S SCLPS=$E(SCH,SCLP) I SCLPS=" " S SCLOOP=SCLOOP+1
  1. I SCLOOP=0 S SCHEX=SCH G SCHQT
  1. S SCLOOP=SCLOOP+1
  1. K SCLHOLD F SCIN=1:1:SCLOOP S (SODL,SCLHOLD(SCIN))=$P(SCH," ",SCIN) D
  1. .Q:$G(SODL)=""
  1. .S SQFLAG=0 F SST=0:0 S SST=$O(^PS(51.1,"B",SODL,SST)) Q:'SST!($G(SQFLAG)) I $P($G(^PS(51.1,SST,0)),"^",8)'="" S SCLHOLD(SCIN)=$P($G(^(0)),"^",8),SQFLAG=1
  1. .Q:$G(SQFLAG)
  1. .I $P($G(^PS(51,"A",SODL)),"^")'="" S SCLHOLD(SCIN)=$P(^(SODL),"^")
  1. S SCHEX="",SQFLAG=0 F SST=1:1:SCLOOP S SCHEX=SCHEX_$S($G(SQFLAG):" ",1:"")_$G(SCLHOLD(SST)),SQFLAG=1
  1. SCHQT ;
  1. S SCH=SCHEX
  1. Q
  1. ;
  1. IVDEA(PSSIVOI,PSSIVOIP) ;CS Federal Schedule/DEA Special Handling to CPRS for IV Fluids dialogue
  1. ;parameter 1 is Orderable Item
  1. ;parameter 2 is "A" for Additive, "S" for Solution
  1. ;Return the CS Federal Schedule code in the VA PRODUCT file (#50.68)
  1. ;or the DEA Special Hndl code depending on the "ND" node of the
  1. ;drugs associated to the Orderable Item.
  1. ;1;1 Sch. I Nar.
  1. ;1;2 II
  1. ;1;2n II Non-Nar.
  1. ;2;3 III
  1. ;2;3n III Non-Nar.
  1. ;2;4 IV
  1. ;2;5 V
  1. ;0 there are other active drugs
  1. ;"" no active drugs
  1. N PSSIVDO,PSSIVDD,PSSIVL,PSSIVLP,PSSIVDEA,PSSIVLPX,PSSK,PSSI,PSSGD
  1. S (PSSIVDO,PSSIVDD)=0
  1. I $G(PSSIVOIP)'="S" S PSSIVOIP="A"
  1. I '$G(PSSIVOI) G IVQ1
  1. S PSSIVL="" F S PSSIVL=$O(^PSDRUG("ASP",PSSIVOI,PSSIVL)) Q:'PSSIVL D
  1. .I $P($G(^PSDRUG(PSSIVL,"I")),"^"),$P($G(^("I")),"^")<DT Q
  1. .I $P($G(^PSDRUG(PSSIVL,2)),"^",3)'["I",$P($G(^(2)),"^",3)'["U" Q
  1. .S PSSIVDD=1
  1. .I PSSIVOIP="A" D Q
  1. ..S (PSSIVLP,PSSIVLPX)=0 F S PSSIVLP=$O(^PSDRUG("A526",PSSIVL,PSSIVLP)) Q:'PSSIVLP!(PSSIVLPX) D
  1. ...I $D(^PS(52.6,PSSIVLP,0)) I '$P($G(^("I")),"^")!($P($G(^("I")),"^")>DT) D IVX
  1. .S (PSSIVLP,PSSIVLPX)=0 F S PSSIVLP=$O(^PSDRUG("A527",PSSIVL,PSSIVLP)) Q:'PSSIVLP!(PSSIVLPX) D
  1. ..I $D(^PS(52.7,PSSIVLP,0)) I '$P($G(^("I")),"^")!($P($G(^("I")),"^")>DT) D IVX
  1. IVQ ;
  1. G:$O(PSSI(""))]"" CSS
  1. S PSSIVLPX="" F S PSSIVLPX=$O(PSSGD(PSSIVLPX)) Q:PSSIVLPX="" D
  1. .I PSSIVLPX[1 S PSSI(1)="" Q
  1. .I PSSIVLPX[2,PSSIVLPX'["C" S PSSI(2)="" Q
  1. .I PSSIVLPX[2,PSSIVLPX["C" S PSSI(2.5)="" Q
  1. .I PSSIVLPX[3,PSSIVLPX'["C" S PSSI(3)="" Q
  1. .I PSSIVLPX[3,PSSIVLPX["C" S PSSI(3.5)="" Q
  1. .I PSSIVLPX[4 S PSSI(4)="" Q
  1. .I PSSIVLPX[5 S PSSI(5)=""
  1. CSS S PSSK=0 S PSSK=$O(PSSI(PSSK)) I PSSK S PSSIVDO=$E(PSSK)_$S($L(PSSK)>1:"n",1:"")
  1. OIQ I PSSIVDO=0 S:'PSSIVDD PSSIVDO=""
  1. I +PSSIVDO=1!(+PSSIVDO=2) S PSSIVDO=1_";"_PSSIVDO
  1. I +PSSIVDO=3!(+PSSIVDO=4)!(+PSSIVDO=5) S PSSIVDO=2_";"_PSSIVDO
  1. Q PSSIVDO
  1. IVQ1 ;
  1. I PSSIVDO=0,'PSSIVDD S PSSIVDO=""
  1. Q PSSIVDO
  1. ;
  1. IVX ;
  1. S (PSSIVDD,PSSIVLPX)=1
  1. S PSSIVDEA=$P($G(^PSDRUG(PSSIVL,0)),"^",3) S:PSSIVDEA]"" PSSGD(PSSIVDEA)=""
  1. I +$P($G(^PSDRUG(PSSIVL,"ND")),"^",3) S PSSK=$P(^("ND"),"^",3) D
  1. .I +$P($G(^PSNDF(50.68,PSSK,7)),"^") S PSSK=$P(^(7),"^"),PSSI($S($E(PSSK,2)="n":$E(PSSK)_".5",1:PSSK))=""
  1. Q
  1. ;
  1. MAXDS(INPUT) ; Returns the Maximum Day Supply to CPRS for a specific Drug or Orderable Item
  1. ; Input: INPUT("PSOI") - PHARMACY ORDERABLE ITEM (#50.7) IEN
  1. ; INPUT("DRUG") - DRUG file (#50) IEN
  1. ;Output: Maximum Days Supply (1 thru 365) - Default: 90
  1. ;
  1. N MAXDS,DRG,DRGMAXDS
  1. I +$G(INPUT("DRUG")) Q $$MXDAYSUP(+INPUT("DRUG"))
  1. S MAXDS=90
  1. I +$G(INPUT("PSOI")) D
  1. . S DRG=0
  1. . F S DRG=$O(^PSDRUG("ASP",+INPUT("PSOI"),DRG)) Q:'DRG D
  1. . . S DRGMAXDS=$$MXDAYSUP(DRG) I DRGMAXDS<MAXDS S MAXDS=DRGMAXDS ;p255 '<' replaces '>'
  1. Q MAXDS
  1. ;
  1. MXDAYSUP(DRUG) ; Returns the Maximum Day Supply for the Dispense Drug
  1. ; Input: DRUG - Pointer to the DRUG file (#50)
  1. ;Output: MXDAYSUP - Maximum Days Supply allowed for the Dispense Drug
  1. ;
  1. N MXDAYSUP,DRGMAXDS,NDFMAXDS,VAPRDIEN,DEASPHLG
  1. ; - Default value = 90
  1. S MXDAYSUP=90
  1. ; - Invalid Dispense Drug
  1. I '$D(^PSDRUG(+$G(DRUG),0)) Q MXDAYSUP
  1. ; - Retrieving Dispense Drug (If value is populated)
  1. S DRGMAXDS=$$GET1^DIQ(50,DRUG,66) I DRGMAXDS S MXDAYSUP=DRGMAXDS
  1. ; - Retrieving NDF Maximum (If Drug is matched to NDF and value is populated)
  1. S VAPRDIEN=+$$GET1^DIQ(50,DRUG,22,"I")
  1. I VAPRDIEN D
  1. . S NDFMAXDS=$$GET1^DIQ(50.68,VAPRDIEN,32)
  1. . I NDFMAXDS,'DRGMAXDS S MXDAYSUP=NDFMAXDS
  1. . I NDFMAXDS,DRGMAXDS,NDFMAXDS<DRGMAXDS S MXDAYSUP=NDFMAXDS
  1. ; - Controlled Substances have different upper limits (not 365)
  1. S DEASPHLG=$$GET1^DIQ(50,DRUG,3)
  1. I DEASPHLG["2",MXDAYSUP>30 S MXDAYSUP=30
  1. I (DEASPHLG["3")!(DEASPHLG["4")!(DEASPHLG["5"),MXDAYSUP>90 S MXDAYSUP=90
  1. ;- Clozapine Drug
  1. I $P($G(^PSDRUG(DRUG,"CLOZ1")),"^")="PSOCLO1" S MXDAYSUP=28
  1. ;
  1. Q MXDAYSUP