- PSJPDV0 ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS (CONT.) ; 7/6/09 2:20pm
- ;;5.0;INPATIENT MEDICATIONS;**12,22,33,214,380,396**;16 DEC 97;Build 1
- ;
- ;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
- ;Reference to ^SC is supported by DBIA 10040
- ;Reference to ^DG(40.8 is supported by DBIA 728
- ;Reference to ^DIC(42 is supported by DBIA 1377
- ;
- ENQ N TMPWD,TMPRB D NOW^%DTC S PSGDT=%,DT=$$DT^XLFDT
- K ^TMP("PSJ",$J),^TMP("PSJPDV",$J)
- D:CHOICE'="IV" UDORD D:CHOICE'="UD" IVORD
- 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
- .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"&$$DIVWARD UDSET D:PSJJORD["V"&$$DIVWARD IVSET
- D ^PSJPDV1
- ;
- 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
- Q
- ;
- DIVWARD() ;DIVISION/WARD MATCH FOR PATIENT (PSJ*5*214)
- N PSJV,PSJVA,PSJVC
- S PSJVA=0
- I $G(VAUTD) I $G(VAUTW) Q 1 ;ALL DIVISIONS/ALL WARDS
- I $D(VAUTW(PSJPWD)) Q 1 ;SPECIFIC WARD MATCHES
- I '$G(VAUTD),'$G(PSJPWD) Q 1 ;specific division & no ward. Elimination will be at order level (CLN label)
- I $G(VAUTW) D Q PSJVA ;SPECIFIC DIVISION MATCHES
- . S PSJVC=0 F S PSJVC=$O(VAUTD(PSJVC)) Q:PSJVC'=+PSJVC S PSJV=VAUTD(PSJVC) I $G(PSJPWD) I PSJV=$P($G(^DG(40.8,+$P($G(^DIC(42,(+PSJPWD),0)),"^",11),0)),U,1) S PSJVA=1
- Q 0
- ;
- UDORD ;find all Unit Dose orders with specified dispense drugs
- 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
- .S PSJJORD=0 F S PSJJORD=$O(^PS(55,"AUD",SPD,PSGP,PSJJORD)) Q:'PSJJORD D
- ..S ND=$G(^PS(55,PSGP,5,PSJJORD,2)) I +$P(ND,U,2)=0!(+$P(ND,U,2)>PSJREPF) Q
- ..Q:'$O(^PS(55,PSGP,5,PSJJORD,1,0))
- ..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
- Q
- ;
- UDSET ;get patient and order information and set in global
- N CLN,SC0
- I '$G(VAUTD),'$G(PSJPWD) S CLN=+$P($G(^PS(55,PSGP,5,PSJJORD,8)),U) Q:'CLN S SC0=+$P($G(^SC(CLN,0)),U,15) Q:'$$CLN(SC0)
- S ND=$G(^PS(55,PSGP,5,PSJJORD,0)),MR=$P(ND,"^",3),MR=$$ENMRN^PSGMI(MR)
- 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_" "
- N X,PSJ
- D DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",30,0,.PSJ,1)
- S DRG=PSJ(1)
- 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
- Q
- IVORD ;get IV orders matching the requested drug
- 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
- .S IVORD=0 F S IVORD=$O(^PS(55,"AIV",IVSPD,IVPSGP,IVORD)) Q:'IVORD D
- ..S ND=$G(^PS(55,IVPSGP,"IV",IVORD,0)) I +$P(ND,U,2)=0!(+$P(ND,U,2)>PSJREPF) Q
- ..D MATADD,MATSOL
- Q
- MATADD ;see if additives of the order match the drug
- Q:'$O(^PS(55,IVPSGP,"IV",IVORD,"AD",0))
- 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
- .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
- Q
- MATSOL ;see if solutions of the order match the drug
- Q:'$O(^PS(55,IVPSGP,"IV",IVORD,"SOL",0))
- 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
- .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
- Q
- ;
- 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)
- ;S IVMR=$$ENMRN^PSGMI(IVMR)
- ;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_" "
- N X,ON55,CLN,SC0 S DFN=PSGP,ON=PSJJORD D GT55^PSIVORFB
- 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
- 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)
- I '$G(VAUTD),'$G(PSJPWD) S CLN=+$P($G(^PS(55,PSGP,"IV",+ON,"DSS")),"^") Q:'CLN S SC0=+$P($G(^SC(CLN,0)),U,15) Q:'$$CLN(SC0)
- 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
- ;
- GETMAT ;see if the patient has the number of drugs necessary to be printed on
- ;the report
- S MATCHES=0 F GG=1:1:$L(PMATCH(PSGP),"^") S GGG=$P(PMATCH(PSGP),"^",GG) S:GGG MATCHES=MATCHES+1
- Q
- ;
- CLN(SDIV) ; check Out patient clinic orders
- N DIV,FLG,PSJVC
- I 'SDIV Q 0
- S FLG=0 I SDIV>0 S DIV=$P(^DG(40.8,SDIV,0),U)
- I DIV]"" S PSJVC=0 F S PSJVC=$O(VAUTD(PSJVC)) Q:PSJVC'=+PSJVC S PSJV=VAUTD(PSJVC) I PSJV=DIV S FLG=1 Q
- Q FLG
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJPDV0 5883 printed Mar 13, 2025@21:13:46 Page 2
- PSJPDV0 ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS (CONT.) ; 7/6/09 2:20pm
- +1 ;;5.0;INPATIENT MEDICATIONS;**12,22,33,214,380,396**;16 DEC 97;Build 1
- +2 ;
- +3 ;Reference to ^PS(52.6 is supported by DBIA 1231
- +4 ;Reference to ^PS(52.7 is supported by DBIA 2173
- +5 ;Reference to ^PS(55 is supported by DBIA 2191
- +6 ;Reference to ^SC is supported by DBIA 10040
- +7 ;Reference to ^DG(40.8 is supported by DBIA 728
- +8 ;Reference to ^DIC(42 is supported by DBIA 1377
- +9 ;
- ENQ NEW TMPWD,TMPRB
- DO NOW^%DTC
- SET PSGDT=%
- SET DT=$$DT^XLFDT
- +1 KILL ^TMP("PSJ",$JOB),^TMP("PSJPDV",$JOB)
- +2 if CHOICE'="IV"
- DO UDORD
- if CHOICE'="UD"
- DO IVORD
- +3 IF $DATA(PMATCH)
- SET PSGP=0
- FOR
- SET PSGP=$ORDER(PMATCH(PSGP))
- if 'PSGP
- QUIT
- DO GETMAT
- IF MATCHES'<PSJMAT&($DATA(^TMP("PSJPDV",$JOB,+PSGP)))
- Begin DoDot:1
- +4 SET PSJACNWP=1
- DO ^PSJAC
- SET TMPWD=PSJPWDN
- SET TMPRB=PSJPRB
- SET NM=PSGP(0)
- SET PSJJORD=0
- FOR
- SET PSJJORD=$ORDER(^TMP("PSJPDV",$JOB,PSGP,PSJJORD))
- if 'PSJJORD
- QUIT
- if PSJJORD'["V"&$$DIVWARD
- DO UDSET
- if PSJJORD["V"&$$DIVWARD
- DO IVSET
- End DoDot:1
- +5 DO ^PSJPDV1
- +6 ;
- DONE KILL ^TMP("PSJ",$JOB),^TMP("PSJPDV",$JOB),%,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
- +1 QUIT
- +2 ;
- DIVWARD() ;DIVISION/WARD MATCH FOR PATIENT (PSJ*5*214)
- +1 NEW PSJV,PSJVA,PSJVC
- +2 SET PSJVA=0
- +3 ;ALL DIVISIONS/ALL WARDS
- IF $GET(VAUTD)
- IF $GET(VAUTW)
- QUIT 1
- +4 ;SPECIFIC WARD MATCHES
- IF $DATA(VAUTW(PSJPWD))
- QUIT 1
- +5 ;specific division & no ward. Elimination will be at order level (CLN label)
- IF '$GET(VAUTD)
- IF '$GET(PSJPWD)
- QUIT 1
- +6 ;SPECIFIC DIVISION MATCHES
- IF $GET(VAUTW)
- Begin DoDot:1
- +7 SET PSJVC=0
- FOR
- SET PSJVC=$ORDER(VAUTD(PSJVC))
- if PSJVC'=+PSJVC
- QUIT
- SET PSJV=VAUTD(PSJVC)
- IF $GET(PSJPWD)
- IF PSJV=$PIECE($GET(^DG(40.8,+$PIECE($GET(^DIC(42,(+PSJPWD),0)),"^",11),0)),U,1)
- SET PSJVA=1
- End DoDot:1
- QUIT PSJVA
- +8 QUIT 0
- +9 ;
- UDORD ;find all Unit Dose orders with specified dispense drugs
- +1 SET SPD=$PIECE(PSJREPS,".")-.0001
- FOR
- SET SPD=$ORDER(^PS(55,"AUD",SPD))
- if 'SPD
- QUIT
- SET PSGP=0
- FOR
- SET PSGP=$ORDER(^PS(55,"AUD",SPD,PSGP))
- if 'PSGP
- QUIT
- Begin DoDot:1
- +2 SET PSJJORD=0
- FOR
- SET PSJJORD=$ORDER(^PS(55,"AUD",SPD,PSGP,PSJJORD))
- if 'PSJJORD
- QUIT
- Begin DoDot:2
- +3 SET ND=$GET(^PS(55,PSGP,5,PSJJORD,2))
- IF +$PIECE(ND,U,2)=0!(+$PIECE(ND,U,2)>PSJREPF)
- QUIT
- +4 if '$ORDER(^PS(55,PSGP,5,PSJJORD,1,0))
- QUIT
- +5 SET PDRG=0
- FOR
- SET PDRG=$ORDER(^PS(55,PSGP,5,PSJJORD,1,PDRG))
- if +PDRG=0
- QUIT
- SET SPPDRG=+$PIECE(^(PDRG,0),"^")
- IF $DATA(PSJISP(SPPDRG_"D"))
- SET ^TMP("PSJPDV",$JOB,PSGP,PSJJORD)=SPD
- SET CLS=PSJISP(SPPDRG_"D")
- SET $PIECE(PMATCH(PSGP),U,+CLS)=+CLS
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- UDSET ;get patient and order information and set in global
- +1 NEW CLN,SC0
- +2 IF '$GET(VAUTD)
- IF '$GET(PSJPWD)
- SET CLN=+$PIECE($GET(^PS(55,PSGP,5,PSJJORD,8)),U)
- if 'CLN
- QUIT
- SET SC0=+$PIECE($GET(^SC(CLN,0)),U,15)
- if '$$CLN(SC0)
- QUIT
- +3 SET ND=$GET(^PS(55,PSGP,5,PSJJORD,0))
- SET MR=$PIECE(ND,"^",3)
- SET MR=$$ENMRN^PSGMI(MR)
- +4 SET ND=$GET(^PS(55,PSGP,5,PSJJORD,2))
- SET DRG=$GET(^(.2))
- SET SCH=$PIECE(ND,"^")
- SET SPD=^TMP("PSJPDV",$JOB,PSGP,PSJJORD)
- SET STD=$SELECT($PIECE(ND,"^",2):$PIECE(ND,"^",2),1:"NOT FOUND")
- SET DO=$PIECE(DRG,"^",2)
- SET DRG=$$ENPDN^PSGMI($PIECE(DRG,"^"))
- IF DO]""
- IF $EXTRACT(DO,$LENGTH(DO))'=" "
- SET DO=DO_" "
- +5 NEW X,PSJ
- +6 DO DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",30,0,.PSJ,1)
- +7 SET DRG=PSJ(1)
- +8 SET ^TMP("PSJ",$JOB,$SELECT(PSJSRT="P":NM_";"_DFN,1:+$GET(STD)),$SELECT(PSJSRT="P":+$GET(STD),1:NM_";"_DFN),PSJJORD)=VA("PID")_"^"_PSJPWDN_"^"_PSJPRB_"^"_DRG_"^"_DO_MR_" "_SCH_"^"_SPD
- +9 QUIT
- IVORD ;get IV orders matching the requested drug
- +1 SET IVSPD=$PIECE(PSJREPS,".")-.0001
- FOR
- SET IVSPD=$ORDER(^PS(55,"AIV",IVSPD))
- if 'IVSPD
- QUIT
- SET IVPSGP=0
- FOR
- SET IVPSGP=$ORDER(^PS(55,"AIV",IVSPD,IVPSGP))
- if 'IVPSGP
- QUIT
- Begin DoDot:1
- +2 SET IVORD=0
- FOR
- SET IVORD=$ORDER(^PS(55,"AIV",IVSPD,IVPSGP,IVORD))
- if 'IVORD
- QUIT
- Begin DoDot:2
- +3 SET ND=$GET(^PS(55,IVPSGP,"IV",IVORD,0))
- IF +$PIECE(ND,U,2)=0!(+$PIECE(ND,U,2)>PSJREPF)
- QUIT
- +4 DO MATADD
- DO MATSOL
- End DoDot:2
- End DoDot:1
- +5 QUIT
- MATADD ;see if additives of the order match the drug
- +1 if '$ORDER(^PS(55,IVPSGP,"IV",IVORD,"AD",0))
- QUIT
- +2 SET ADD=0
- FOR
- SET ADD=$ORDER(^PS(55,IVPSGP,"IV",IVORD,"AD",ADD))
- if 'ADD
- QUIT
- SET ND=$GET(^(ADD,0))
- SET ND2=$GET(^PS(52.6,+$PIECE(ND,"^"),0))
- Begin DoDot:1
- +3 IF ND2]""
- IF $DATA(PSJISP($SELECT(PSJSL="O":+$PIECE($GET(ND2),U,11)_"O",1:+$PIECE($GET(ND2),U,2)_"D")))
- SET CLS=PSJISP($SELECT(PSJSL="O":$PIECE(ND2,"^",11)_"O",1:$PIECE(ND2,"^",2)_"D"))
- SET $PIECE(PMATCH(IVPSGP),U,+CLS)=+CLS
- SET ^TMP("PSJPDV",$JOB,IVPSGP,IVORD_"V")=IVSPD
- End DoDot:1
- +4 QUIT
- MATSOL ;see if solutions of the order match the drug
- +1 if '$ORDER(^PS(55,IVPSGP,"IV",IVORD,"SOL",0))
- QUIT
- +2 SET SOL=0
- FOR
- SET SOL=$ORDER(^PS(55,IVPSGP,"IV",IVORD,"SOL",SOL))
- if 'SOL
- QUIT
- SET ND=$GET(^(SOL,0))
- SET ND2=$GET(^PS(52.7,+$PIECE(ND,"^"),0))
- Begin DoDot:1
- +3 IF ND2]""
- IF $DATA(PSJISP($SELECT(PSJSL="O":+$PIECE($GET(ND2),U,11)_"O",1:+$PIECE($GET(ND2),U,2)_"D")))
- SET CLS=PSJISP($SELECT(PSJSL="O":$PIECE(ND2,"^",11)_"O",1:$PIECE(ND2,"^",2)_"D"))
- SET $PIECE(PMATCH(IVPSGP),U,+CLS)=+CLS
- SET ^TMP("PSJPDV",$JOB,IVPSGP,IVORD_"V")=IVSPD
- End DoDot:1
- +4 QUIT
- +5 ;
- 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)
- +1 ;S IVMR=$$ENMRN^PSGMI(IVMR)
- +2 ;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_" "
- +3 NEW X,ON55,CLN,SC0
- SET DFN=PSGP
- SET ON=PSJJORD
- DO GT55^PSIVORFB
- +4 SET DRG=$SELECT($DATA(DRG("AD",1)):$PIECE(DRG("AD",1),U,2),1:$PIECE(DRG("SOL",1),U,2))
- SET IVSCH=P(9)
- SET IVSTD=P(2)
- SET IVSPD=^TMP("PSJPDV",$JOB,PSGP,PSJJORD)
- SET IVMR=$PIECE(P("MR"),U,2)
- SET IVIR=P(8)
- SET IVDRG=DRG
- +5 SET PSJPWDN=$SELECT($GET(^PS(55,PSGP,"IV",+ON,"DSS")):$PIECE($GET(^SC(+$GET(^PS(55,PSGP,"IV",+ON,"DSS")),0)),"^"),($GET(PSJPDD)]""&(IVSTD>+PSJPDD)):"",1:TMPWD)
- SET PSJPRB=$SELECT($GET(^PS(55,PSGP,"IV",+ON,"DSS")):"",($GET(PSJPDD)]""&(IVSTD>+PSJPDD)):"",1:TMPRB)
- +6 IF '$GET(VAUTD)
- IF '$GET(PSJPWD)
- SET CLN=+$PIECE($GET(^PS(55,PSGP,"IV",+ON,"DSS")),"^")
- if 'CLN
- QUIT
- SET SC0=+$PIECE($GET(^SC(CLN,0)),U,15)
- if '$$CLN(SC0)
- QUIT
- +7 SET ^TMP("PSJ",$JOB,$SELECT(PSJSRT="P":NM_";"_DFN,1:+$GET(IVSTD)),$SELECT(PSJSRT="P":+$GET(IVSTD),1:NM_";"_DFN),PSJJORD)=VA("PID")_"^"_PSJPWDN_"^"_PSJPRB_"^"_IVDRG_"^"_IVMR_" "_IVSCH_" "_IVIR_"^"_IVSPD
- +8 ;
- GETMAT ;see if the patient has the number of drugs necessary to be printed on
- +1 ;the report
- +2 SET MATCHES=0
- FOR GG=1:1:$LENGTH(PMATCH(PSGP),"^")
- SET GGG=$PIECE(PMATCH(PSGP),"^",GG)
- if GGG
- SET MATCHES=MATCHES+1
- +3 QUIT
- +4 ;
- CLN(SDIV) ; check Out patient clinic orders
- +1 NEW DIV,FLG,PSJVC
- +2 IF 'SDIV
- QUIT 0
- +3 SET FLG=0
- IF SDIV>0
- SET DIV=$PIECE(^DG(40.8,SDIV,0),U)
- +4 IF DIV]""
- SET PSJVC=0
- FOR
- SET PSJVC=$ORDER(VAUTD(PSJVC))
- if PSJVC'=+PSJVC
- QUIT
- SET PSJV=VAUTD(PSJVC)
- IF PSJV=DIV
- SET FLG=1
- QUIT
- +5 QUIT FLG
