- APSPCDI1 ; IHS/MSC/PLS - CRITICAL DRUG INTERACTION REPORT ;28-Nov-2011 14:53;PLS
- ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
- ;
- Q
- PRINT ;EP
- N APSPPG,DFLG,NEWPG
- S (APSPPG,DFLG,NEWPG)=0
- D HDR
- D PRINT1
- W:'DFLG !,"No data found..."
- Q
- ;
- PRINT1 ;EP
- N DIV,SUB1,SUB2,SUB3,SUB4,SUB5,VAL,LP,LSTFDT
- S LSTFDT=0
- S DIV=0 F S DIV=$O(^TMP($J,"XREF",DIV)) Q:'DIV D
- .I APSPDIV="*" W !!!,"Pharmacy Division: "_$$GET1^DIQ(59,DIV,.01),! ;W !,"|"_$$GET1^DIQ(59,DIV,.01)_"|" D PRINT3()
- .I APSPSORT=1 D ; Drug Name
- ..S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1)) Q:SUB1="" D ; Drug Name
- ...S SUB2=0 F S SUB2=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2)) Q:'SUB2 D ; Fill Date
- ....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Data node
- .....D PRINT2(^TMP($J,"DATA",SUB3))
- .....S DFLG=1
- .I APSPSORT=2 D ; Fill Date
- ..S SUB1=0 F S SUB1=$O(^TMP($J,"XREF",DIV,"FDT",SUB1)) Q:'SUB1 D ; Fill Date
- ...S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"FDT",SUB1,SUB2)) Q:SUB2="" D ; Drug Name
- ....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"FDT",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Data node
- .....D PRINT2(^TMP($J,"DATA",SUB3))
- .....S DFLG=1
- .I APSPSORT=3 D ; Patient Name
- ..S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"PAT",SUB1)) Q:'$L(SUB1) D ; Patient Name
- ...S SUB2=0 F S SUB2=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2)) Q:'SUB2 D ; Fill Date
- ....S SUB3="" F S SUB3=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2,SUB3)) Q:'$L(SUB3) D ; Drug Name
- .....S SUB4=0 F S SUB4=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4 D ; Data node
- ......D PRINT2(^TMP($J,"DATA",SUB4))
- ......S DFLG=1
- .I APSPSORT=4 D ; Provider
- ..S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"PRV",SUB1)) Q:'$L(SUB1) D ; Provider
- ...S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2)) Q:'$L(SUB2) D ; Drug Name
- ....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Fill Date
- .....S SUB4=0 F S SUB4=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4 D ; Data node
- ......D PRINT2(^TMP($J,"DATA",SUB4))
- ......S DFLG=1
- Q
- ; Print the line
- PRINT2(DATA) ; EP -
- N RX,DFN,HRN
- I $P(DATA,U,3)="APSP" D
- .D APSPINV(+DATA)
- E D
- .S RX=+DATA
- .S DFN=$$GET1^DIQ(52,RX,2,"I")
- .S HRN=$$HRN^AUPNPAT(DFN,DUZ(2))
- .D PRINT3($P(DATA,U,16)+1)
- .W !,$P($TR($$FMTE^XLFDT($P(DATA,U,2),"5Z"),"@"," "),":",1,2),?14,$P(DATA,U,9),?20,$E($$GET1^DIQ(2,DFN,.01),1,16),?38,HRN,?48,$$GET1^DIQ(52,RX,.01),?60,$P(DATA,U,8)
- .D INTOUT(RX)
- D PRINT3() ;check page length
- Q
- ; Check page length and optionally print blank line
- ;
- PRINT3(ADD) ;EP
- S ADD=$G(ADD,0)
- D:($Y+9+ADD)>IOSL HDR
- Q
- ;
- HDR ;EP
- W:APSPPG @IOF
- S APSPPG=APSPPG+1,NEWPG=1
- W !,"Critical Drug Interaction Report",?(IOM-28),$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
- W !,"Report Criteria:"
- W !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
- W !,?5,"Pharmacy Division: "_$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
- W !,?5,"Sorted by: "_$S(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=2:"Fill Date then Drug Name",APSPSORT=3:"Patient then Fill Date",4:"Prescriber then Drug Name, Fill Date",1:"Unknown")
- I APSPSORT=3,APSPPAT W !,?7,"Patient sort restricted to ",$$GET1^DIQ(2,APSPPAT,.01)
- I APSPSORT=4,APSPPRV W !,?7,"Prescriber sort restricted to ",$$GET1^DIQ(200,APSPPRV,.01)
- D HDR1
- Q
- ;
- HDR1 ;EP
- D DASH
- W "Date Disp.",?14,"Type",?20,"Patient",?40,"HRN",?48,"Rx Number",?60,"Drug Name"
- W !,?37,"Overriding Provider"
- W !,?7,"Overriding Reason"
- W !,"Cause"
- D DASH
- Q
- ;
- DASH ;EP
- N DASH
- W ! F DASH=1:1:IOM W "-"
- W !
- Q
- ; Output order check information
- INTOUT(RX) ;EP-
- N IEN,CNT,ORDID,IENS,CAUSE
- S (IEN,CNT)=0
- S ORDID=$P(^PSRX(RX,"OR1"),U,2)
- F S IEN=$O(^OR(100,ORDID,9,IEN)) Q:'IEN D
- .Q:$$GET1^DIQ(100.8,$P($G(^OR(100,+ORDID,9,IEN,0)),U),.01)'="CRITICAL DRUG INTERACTION"
- .S IENS=IEN_","_ORDID_","
- .W !,?5,$$GET1^DIQ(100.09,IENS,.01),?37,$$GET1^DIQ(100.09,IENS,.05)
- .W !,?7,$$GET1^DIQ(100.09,IENS,.04)
- .S CAUSE=$P($G(^OR(100,+ORDID,9,IEN,1)),":",2)
- .I $L(CAUSE) D
- ..W !,$S($L(CAUSE)>IOM:$E(CAUSE,1,IOM-3)_"...",1:CAUSE)
- Q
- ; Output APSP Intervention
- APSPINV(IEN) ;EP-
- N FN,DFN,NODE0
- S FN=9009032.4
- S NODE0=^APSPQA(32.4,IEN,0)
- S DFN=$P(NODE0,U,2)
- W !,?5,$P($TR($$FMTE^XLFDT($P(NODE0,U),"5Z"),"@"," "),":",1,2),?21,$$GET1^DIQ(2,DFN,.01),?51,$$HRN^AUPNPAT(DFN,$$GET1^DIQ(59,$P(NODE0,U,16),100,"I")),?58,$$GET1^DIQ(FN,IEN,.05)
- W !,?7,$$GET1^DIQ(200,$P(NODE0,U,4),.01),?49,$$GET1^DIQ(FN,IEN,.08)
- W !,"Critical Drug Interaction over-ridden in RPMS Pharmacy Package"
- Q
- APSPCDI1 ; IHS/MSC/PLS - CRITICAL DRUG INTERACTION REPORT ;28-Nov-2011 14:53;PLS
- +1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
- +2 ;
- +3 QUIT
- PRINT ;EP
- +1 NEW APSPPG,DFLG,NEWPG
- +2 SET (APSPPG,DFLG,NEWPG)=0
- +3 DO HDR
- +4 DO PRINT1
- +5 IF 'DFLG
- WRITE !,"No data found..."
- +6 QUIT
- +7 ;
- PRINT1 ;EP
- +1 NEW DIV,SUB1,SUB2,SUB3,SUB4,SUB5,VAL,LP,LSTFDT
- +2 SET LSTFDT=0
- +3 SET DIV=0
- FOR
- SET DIV=$ORDER(^TMP($JOB,"XREF",DIV))
- IF 'DIV
- QUIT
- Begin DoDot:1
- +4 ;W !,"|"_$$GET1^DIQ(59,DIV,.01)_"|" D PRINT3()
- IF APSPDIV="*"
- WRITE !!!,"Pharmacy Division: "_$$GET1^DIQ(59,DIV,.01),!
- +5 ; Drug Name
- IF APSPSORT=1
- Begin DoDot:2
- +6 ; Drug Name
- SET SUB1=""
- FOR
- SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1))
- IF SUB1=""
- QUIT
- Begin DoDot:3
- +7 ; Fill Date
- SET SUB2=0
- FOR
- SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1,SUB2))
- IF 'SUB2
- QUIT
- Begin DoDot:4
- +8 ; Data node
- SET SUB3=0
- FOR
- SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1,SUB2,SUB3))
- IF 'SUB3
- QUIT
- Begin DoDot:5
- +9 DO PRINT2(^TMP($JOB,"DATA",SUB3))
- +10 SET DFLG=1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +11 ; Fill Date
- IF APSPSORT=2
- Begin DoDot:2
- +12 ; Fill Date
- SET SUB1=0
- FOR
- SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1))
- IF 'SUB1
- QUIT
- Begin DoDot:3
- +13 ; Drug Name
- SET SUB2=""
- FOR
- SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1,SUB2))
- IF SUB2=""
- QUIT
- Begin DoDot:4
- +14 ; Data node
- SET SUB3=0
- FOR
- SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1,SUB2,SUB3))
- IF 'SUB3
- QUIT
- Begin DoDot:5
- +15 DO PRINT2(^TMP($JOB,"DATA",SUB3))
- +16 SET DFLG=1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +17 ; Patient Name
- IF APSPSORT=3
- Begin DoDot:2
- +18 ; Patient Name
- SET SUB1=""
- FOR
- SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1))
- IF '$LENGTH(SUB1)
- QUIT
- Begin DoDot:3
- +19 ; Fill Date
- SET SUB2=0
- FOR
- SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2))
- IF 'SUB2
- QUIT
- Begin DoDot:4
- +20 ; Drug Name
- SET SUB3=""
- FOR
- SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2,SUB3))
- IF '$LENGTH(SUB3)
- QUIT
- Begin DoDot:5
- +21 ; Data node
- SET SUB4=0
- FOR
- SET SUB4=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2,SUB3,SUB4))
- IF 'SUB4
- QUIT
- Begin DoDot:6
- +22 DO PRINT2(^TMP($JOB,"DATA",SUB4))
- +23 SET DFLG=1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +24 ; Provider
- IF APSPSORT=4
- Begin DoDot:2
- +25 ; Provider
- SET SUB1=""
- FOR
- SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1))
- IF '$LENGTH(SUB1)
- QUIT
- Begin DoDot:3
- +26 ; Drug Name
- SET SUB2=""
- FOR
- SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2))
- IF '$LENGTH(SUB2)
- QUIT
- Begin DoDot:4
- +27 ; Fill Date
- SET SUB3=0
- FOR
- SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2,SUB3))
- IF 'SUB3
- QUIT
- Begin DoDot:5
- +28 ; Data node
- SET SUB4=0
- FOR
- SET SUB4=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2,SUB3,SUB4))
- IF 'SUB4
- QUIT
- Begin DoDot:6
- +29 DO PRINT2(^TMP($JOB,"DATA",SUB4))
- +30 SET DFLG=1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +31 QUIT
- +32 ; Print the line
- PRINT2(DATA) ; EP -
- +1 NEW RX,DFN,HRN
- +2 IF $PIECE(DATA,U,3)="APSP"
- Begin DoDot:1
- +3 DO APSPINV(+DATA)
- End DoDot:1
- +4 IF '$TEST
- Begin DoDot:1
- +5 SET RX=+DATA
- +6 SET DFN=$$GET1^DIQ(52,RX,2,"I")
- +7 SET HRN=$$HRN^AUPNPAT(DFN,DUZ(2))
- +8 DO PRINT3($PIECE(DATA,U,16)+1)
- +9 WRITE !,$PIECE($TRANSLATE($$FMTE^XLFDT($PIECE(DATA,U,2),"5Z"),"@"," "),":",1,2),?14,$PIECE(DATA,U,9),?20,$EXTRACT($$GET1^DIQ(2,DFN,.01),1,16),?38,HRN,?48,$$GET1^DIQ(52,RX,.01),?60,$PIECE(DATA,U,8)
- +10 DO INTOUT(RX)
- End DoDot:1
- +11 ;check page length
- DO PRINT3()
- +12 QUIT
- +13 ; Check page length and optionally print blank line
- +14 ;
- PRINT3(ADD) ;EP
- +1 SET ADD=$GET(ADD,0)
- +2 IF ($Y+9+ADD)>IOSL
- DO HDR
- +3 QUIT
- +4 ;
- HDR ;EP
- +1 IF APSPPG
- WRITE @IOF
- +2 SET APSPPG=APSPPG+1
- SET NEWPG=1
- +3 WRITE !,"Critical Drug Interaction Report",?(IOM-28),$PIECE($TRANSLATE($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
- +4 WRITE !,"Report Criteria:"
- +5 WRITE !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
- +6 WRITE !,?5,"Pharmacy Division: "_$SELECT(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
- +7 WRITE !,?5,"Sorted by: "_$SELECT(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=2:"Fill Date then Drug Name",APSPSORT=3:"Patient then Fill Date",4:"Prescriber then Drug Name, Fill Date",1:"Unknown")
- +8 IF APSPSORT=3
- IF APSPPAT
- WRITE !,?7,"Patient sort restricted to ",$$GET1^DIQ(2,APSPPAT,.01)
- +9 IF APSPSORT=4
- IF APSPPRV
- WRITE !,?7,"Prescriber sort restricted to ",$$GET1^DIQ(200,APSPPRV,.01)
- +10 DO HDR1
- +11 QUIT
- +12 ;
- HDR1 ;EP
- +1 DO DASH
- +2 WRITE "Date Disp.",?14,"Type",?20,"Patient",?40,"HRN",?48,"Rx Number",?60,"Drug Name"
- +3 WRITE !,?37,"Overriding Provider"
- +4 WRITE !,?7,"Overriding Reason"
- +5 WRITE !,"Cause"
- +6 DO DASH
- +7 QUIT
- +8 ;
- DASH ;EP
- +1 NEW DASH
- +2 WRITE !
- FOR DASH=1:1:IOM
- WRITE "-"
- +3 WRITE !
- +4 QUIT
- +5 ; Output order check information
- INTOUT(RX) ;EP-
- +1 NEW IEN,CNT,ORDID,IENS,CAUSE
- +2 SET (IEN,CNT)=0
- +3 SET ORDID=$PIECE(^PSRX(RX,"OR1"),U,2)
- +4 FOR
- SET IEN=$ORDER(^OR(100,ORDID,9,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +5 IF $$GET1^DIQ(100.8,$PIECE($GET(^OR(100,+ORDID,9,IEN,0)),U),.01)'="CRITICAL DRUG INTERACTION"
- QUIT
- +6 SET IENS=IEN_","_ORDID_","
- +7 WRITE !,?5,$$GET1^DIQ(100.09,IENS,.01),?37,$$GET1^DIQ(100.09,IENS,.05)
- +8 WRITE !,?7,$$GET1^DIQ(100.09,IENS,.04)
- +9 SET CAUSE=$PIECE($GET(^OR(100,+ORDID,9,IEN,1)),":",2)
- +10 IF $LENGTH(CAUSE)
- Begin DoDot:2
- +11 WRITE !,$SELECT($LENGTH(CAUSE)>IOM:$EXTRACT(CAUSE,1,IOM-3)_"...",1:CAUSE)
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ; Output APSP Intervention
- APSPINV(IEN) ;EP-
- +1 NEW FN,DFN,NODE0
- +2 SET FN=9009032.4
- +3 SET NODE0=^APSPQA(32.4,IEN,0)
- +4 SET DFN=$PIECE(NODE0,U,2)
- +5 WRITE !,?5,$PIECE($TRANSLATE($$FMTE^XLFDT($PIECE(NODE0,U),"5Z"),"@"," "),":",1,2),?21,$$GET1^DIQ(2,DFN,.01),?51,$$HRN^AUPNPAT(DFN,$$GET1^DIQ(59,$PIECE(NODE0,U,16),100,"I")),?58,$$GET1^DIQ(FN,IEN,.05)
- +6 WRITE !,?7,$$GET1^DIQ(200,$PIECE(NODE0,U,4),.01),?49,$$GET1^DIQ(FN,IEN,.08)
- +7 WRITE !,"Critical Drug Interaction over-ridden in RPMS Pharmacy Package"
- +8 QUIT
