| 1 | PSJPDV0 ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS (CONT.) ;10 Dec 98 / 8:21 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**12,22,33**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 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 | ;Reference to ^SC is supported by DBIA 10040
|
---|
| 8 | ;
|
---|
| 9 | ENQ N TMPWD,TMPRB D NOW^%DTC S PSGDT=%,DT=$$DT^XLFDT
|
---|
| 10 | K ^TMP("PSJ",$J),^TMP("PSJPDV",$J)
|
---|
| 11 | D:CHOICE'="IV" UDORD D:CHOICE'="UD" IVORD
|
---|
| 12 | I $D(PMATCH) S PSGP=0 F S PSGP=$O(PMATCH(PSGP)) Q:'PSGP D GETMAT I MATCHES'<PSJMAT&($D(^TMP("PSJPDV",$J,+PSGP))) D
|
---|
| 13 | .S PSJACNWP=1 D ^PSJAC S TMPWD=PSJPWDN,TMPRB=PSJPRB,NM=PSGP(0),PSJJORD=0 F S PSJJORD=$O(^TMP("PSJPDV",$J,PSGP,PSJJORD)) Q:'PSJJORD D:PSJJORD'["V" UDSET D:PSJJORD["V" IVSET
|
---|
| 14 | D ^PSJPDV1
|
---|
| 15 | ;
|
---|
| 16 | DONE K ^TMP("PSJ",$J),^TMP("PSJPDV",$J),%,ADD,CHOICE,CLS,DFN,DO,DRG,IVDO,IVDRG,IVIR,IVMR,IVND,IVORD,IVPSGP,IVSCH,IVSPD,IVSTD,MR,ND,ND2,NM,PATDRG,PDRG,PMATCH,PSGDT,PSGP,PSJJORD,SCH,SOL,SPD,SPPDRG,STD,VA,VADM,VAIN
|
---|
| 17 | Q
|
---|
| 18 | ;
|
---|
| 19 | UDORD ;find all Unit Dose orders with specified dispense drugs
|
---|
| 20 | S SPD=$P(PSJREPS,".")-.0001 F S SPD=$O(^PS(55,"AUD",SPD)) Q:'SPD S PSGP=0 F S PSGP=$O(^PS(55,"AUD",SPD,PSGP)) Q:'PSGP D
|
---|
| 21 | .S PSJJORD=0 F S PSJJORD=$O(^PS(55,"AUD",SPD,PSGP,PSJJORD)) Q:'PSJJORD D
|
---|
| 22 | ..S ND=$G(^PS(55,PSGP,5,PSJJORD,2)) I +$P(ND,U,2)=0!(+$P(ND,U,2)>PSJREPF) Q
|
---|
| 23 | ..Q:'$O(^PS(55,PSGP,5,PSJJORD,1,0))
|
---|
| 24 | ..S PDRG=0 F S PDRG=$O(^PS(55,PSGP,5,PSJJORD,1,PDRG)) Q:+PDRG=0 S SPPDRG=+$P(^(PDRG,0),"^") I $D(PSJISP(SPPDRG_"D")) S ^TMP("PSJPDV",$J,PSGP,PSJJORD)=SPD,CLS=PSJISP(SPPDRG_"D"),$P(PMATCH(PSGP),U,+CLS)=+CLS
|
---|
| 25 | Q
|
---|
| 26 | ;
|
---|
| 27 | UDSET ;get patient and order information and set in global
|
---|
| 28 | S ND=$G(^PS(55,PSGP,5,PSJJORD,0)),MR=$P(ND,"^",3),MR=$$ENMRN^PSGMI(MR)
|
---|
| 29 | S ND=$G(^PS(55,PSGP,5,PSJJORD,2)),DRG=$G(^(.2)),SCH=$P(ND,"^"),SPD=^TMP("PSJPDV",$J,PSGP,PSJJORD),STD=$S($P(ND,"^",2):$P(ND,"^",2),1:"NOT FOUND"),DO=$P(DRG,"^",2),DRG=$$ENPDN^PSGMI($P(DRG,"^")) I DO]"",$E(DO,$L(DO))'=" " S DO=DO_" "
|
---|
| 30 | N X,PSJ
|
---|
| 31 | D DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",30,0,.PSJ,1)
|
---|
| 32 | S DRG=PSJ(1)
|
---|
| 33 | S ^TMP("PSJ",$J,$S(PSJSRT="P":NM_";"_DFN,1:+$G(STD)),$S(PSJSRT="P":+$G(STD),1:NM_";"_DFN),PSJJORD)=VA("PID")_"^"_PSJPWDN_"^"_PSJPRB_"^"_DRG_"^"_DO_MR_" "_SCH_"^"_SPD
|
---|
| 34 | Q
|
---|
| 35 | IVORD ;get IV orders matching the requested drug
|
---|
| 36 | S IVSPD=$P(PSJREPS,".")-.0001 F S IVSPD=$O(^PS(55,"AIV",IVSPD)) Q:'IVSPD S IVPSGP=0 F S IVPSGP=$O(^PS(55,"AIV",IVSPD,IVPSGP)) Q:'IVPSGP D
|
---|
| 37 | .S IVORD=0 F S IVORD=$O(^PS(55,"AIV",IVSPD,IVPSGP,IVORD)) Q:'IVORD D
|
---|
| 38 | ..S ND=$G(^PS(55,IVPSGP,"IV",IVORD,0)) I +$P(ND,U,2)=0!(+$P(ND,U,2)>PSJREPF) Q
|
---|
| 39 | ..D MATADD,MATSOL
|
---|
| 40 | Q
|
---|
| 41 | MATADD ;see if additives of the order match the drug
|
---|
| 42 | Q:'$O(^PS(55,IVPSGP,"IV",IVORD,"AD",0))
|
---|
| 43 | S ADD=0 F S ADD=$O(^PS(55,IVPSGP,"IV",IVORD,"AD",ADD)) Q:'ADD S ND=$G(^(ADD,0)),ND2=$G(^PS(52.6,+$P(ND,"^"),0)) D
|
---|
| 44 | .I ND2]"" I $D(PSJISP($S(PSJSL="O":+$P($G(ND2),U,11)_"O",1:+$P($G(ND2),U,2)_"D"))) S CLS=PSJISP($S(PSJSL="O":$P(ND2,"^",11)_"O",1:$P(ND2,"^",2)_"D")),$P(PMATCH(IVPSGP),U,+CLS)=+CLS,^TMP("PSJPDV",$J,IVPSGP,IVORD_"V")=IVSPD
|
---|
| 45 | Q
|
---|
| 46 | MATSOL ;see if solutions of the order match the drug
|
---|
| 47 | Q:'$O(^PS(55,IVPSGP,"IV",IVORD,"SOL",0))
|
---|
| 48 | S SOL=0 F S SOL=$O(^PS(55,IVPSGP,"IV",IVORD,"SOL",SOL)) Q:'SOL S ND=$G(^(SOL,0)),ND2=$G(^PS(52.7,+$P(ND,"^"),0)) D
|
---|
| 49 | .I ND2]"" I $D(PSJISP($S(PSJSL="O":+$P($G(ND2),U,11)_"O",1:+$P($G(ND2),U,2)_"D"))) S CLS=PSJISP($S(PSJSL="O":$P(ND2,"^",11)_"O",1:$P(ND2,"^",2)_"D")),$P(PMATCH(IVPSGP),U,+CLS)=+CLS,^TMP("PSJPDV",$J,IVPSGP,IVORD_"V")=IVSPD
|
---|
| 50 | Q
|
---|
| 51 | ;
|
---|
| 52 | IVSET ;S IVND=$G(^PS(55,PSGP,"IV",+PSJJORD,0)),IVSCH=$P(IVND,"^",9),IVSTD=$P(IVND,"^",2),IVSPD=^TMP("PSJPDV",$J,PSGP,PSJJORD),IVMR=$P($G(^PS(55,PSGP,"IV",+PSJJORD,6)),"^",3),IVIR=$P(IVND,"^",8)
|
---|
| 53 | ;S IVMR=$$ENMRN^PSGMI(IVMR)
|
---|
| 54 | ;S IVDRG=$G(^PS(55,PSGP,"IV",+PSJJORD,6)),IVDO=$P(IVDRG,"^",2),IVDRG=$$ENPDN^PSGMI($P(IVDRG,"^")) I IVDO]"",$E(IVDO,$L(IVDO))'=" " S IVDO=IVDO_" "
|
---|
| 55 | N X,ON55 S DFN=PSGP,ON=PSJJORD D GT55^PSIVORFB
|
---|
| 56 | S DRG=$S($D(DRG("AD",1)):$P(DRG("AD",1),U,2),1:$P(DRG("SOL",1),U,2)),IVSCH=P(9),IVSTD=P(2),IVSPD=^TMP("PSJPDV",$J,PSGP,PSJJORD),IVMR=$P(P("MR"),U,2),IVIR=P(8),IVDRG=DRG
|
---|
| 57 | S PSJPWDN=$S($G(^PS(55,PSGP,"IV",+ON,"DSS")):$P($G(^SC(+$G(^PS(55,PSGP,"IV",+ON,"DSS")),0)),"^"),($G(PSJPDD)]""&(IVSTD>+PSJPDD)):"",1:TMPWD),PSJPRB=$S($G(^PS(55,PSGP,"IV",+ON,"DSS")):"",($G(PSJPDD)]""&(IVSTD>+PSJPDD)):"",1:TMPRB)
|
---|
| 58 | S ^TMP("PSJ",$J,$S(PSJSRT="P":NM_";"_DFN,1:+$G(IVSTD)),$S(PSJSRT="P":+$G(IVSTD),1:NM_";"_DFN),PSJJORD)=VA("PID")_"^"_PSJPWDN_"^"_PSJPRB_"^"_IVDRG_"^"_IVMR_" "_IVSCH_" "_IVIR_"^"_IVSPD
|
---|
| 59 | ;
|
---|
| 60 | GETMAT ;see if the patient has the number of drugs necessary to be printed on
|
---|
| 61 | ;the report
|
---|
| 62 | S MATCHES=0 F GG=1:1:$L(PMATCH(PSGP),"^") S GGG=$P(PMATCH(PSGP),"^",GG) S:GGG MATCHES=MATCHES+1
|
---|
| 63 | Q
|
---|