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

APCLACGM.m

Go to the documentation of this file.
  1. APCLACGM ;IHS/CMI/LAB - A/C monthly report; [ 12/9/2009 19:39 PM ]
  1. ;;2.0;IHS PCC SUITE;**2,5,10,11**;MAY 14, 2009;Build 58
  1. ;
  1. ;
  1. D PRINT
  1. K ^XTMP("APCLACG",APCLJOB,APCLBTH)
  1. K APCLJOB,APCLBTH
  1. D DONE^APCLOSUT
  1. Q
  1. PRINT ;
  1. S APCL80S="-------------------------------------------------------------------------------"
  1. D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y
  1. S (APCLPG,APCLAP)=0
  1. K APCLQUIT
  1. D HEAD
  1. ;S (APCLUPWR,APCLUPOP,APCLUPAC,APCLRPOP,APCLRPWR,APCLRPAC)=999999
  1. S APCLSHD=""
  1. W !,"Date Range:",?40,$$FMTE^XLFDT(APCLBD)," - ",$$FMTE^XLFDT(APCLED),!
  1. W !,"Total Demographics",!
  1. W !,"User Population",?40,$J($$C(APCLUPOP,0,8),12),!
  1. W !,"Number of patients in the User Population",!
  1. W "who had a prescription for Warfarin in the",!
  1. W "45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$J($$C(APCLUPWR,0,8),12),?55,$$PER(APCLUPWR,APCLUPOP)," (of User Pop)",!
  1. W !,"Number of patients on Warfarin managed "
  1. W !,"by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$J($$C(APCLUPAC,0,8),12),?55,$$PER(APCLUPAC,APCLUPWR)," (of Warfarin Pop)"
  1. I $Y>(IOSL-8) D HEAD Q:$D(APCLQUIT)
  1. RPTPOP ;report population
  1. W !!,"Report Demographics",!
  1. W !,"Report Population:" D
  1. .I APCLGRP="W" W ?40,"Warfarin Patients",!
  1. .I APCLGRP="A" W ?40,"Anticoagulation Clinic Patients",! D
  1. ..S X=0 F S X=$O(APCLACCR(X)) Q:X'=+X W ?40,$P(^DIC(40.7,X,0),U),!
  1. .I APCLGRP="S" W ?40,"Search Template: ",!?40,$P(^DIBT(APCLSTMP,0),U),!
  1. .I APCLGRP="I" W ?40,"iCare Panel: ",!?40,$P(APCLICP,U,3),!
  1. .I APCLGRP="E" W ?40,"EHR Personal List: ",!?40,$P(APCLICP,U,3),!
  1. W !,"Number of patients included on this",!,"report",?40,$J($$C(APCLRPOP,0,8),12),!
  1. I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included in this ",!
  1. W "report who had a prescription for Warfarin ",!
  1. W "in the 45 days prior to ",$$FMTE^XLFDT(APCLED),".",?40,$J($$C(APCLRPWR,0,8),12),?55,$$PER(APCLRPWR,APCLRPOP)," (of Report Pop)",!
  1. I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients on Warfarin managed ",!
  1. W "by the Anticoagulation Clinic (had a visit",!,"to Anticoagulation clinic in the ",!,"time period",?40,$J($$C(APCLRPWA,0,8),12),?55,$$PER(APCLRPWA,APCLRPWR)," (of Warfarin Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin",!
  1. W "AND had a documented INR within the 45",!
  1. W "days prior to the end of the report:",?40,$J($$C(APCLRPIN,0,8),12),?55,$$PER(APCLRPIN,APCLRPWR)," (of Rep/INR Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin",!
  1. W "AND had an INR value greater than or equal",!
  1. W "to 9.0 during the report date range:",?40,$J($$C(APCLRPI9,0,8),12),?55,$$PER(APCLRPI9,APCLRPIN)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
  1. W !?3,"Patients who had an INR > 9 this month:",!
  1. D SUBHEAD1
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD1
  1. .W ?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .S APCLVD=0 F S APCLVD=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD)) Q:APCLVD=""!($D(APCLQUIT)) D
  1. ..S APCLI=0 F S APCLI=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI)) Q:APCLI'=+APCLI!($D(APCLQUIT)) D
  1. ...S APCLR=^XTMP("APCLACG",APCLJOB,APCLBTH,"INR >9",DFN,APCLVD,APCLI)
  1. ...W ?43,$P($$INRGOAL(DFN,APCLED),U,1),?56,APCLR,?66,$$D1^APCHSMU(APCLVD),!
  1. .;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD1
  1. .K APCLD
  1. .S %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED,E=$$START1^APCLDF(%,"APCLD(")
  1. .W ?3,"Indication for Anticoag Therapy:"
  1. .S X=0 F S X=$O(APCLD(X)) Q:X'=+X W " ",$P(APCLD(X),U,2)
  1. .W !
  1. VITK ;
  1. I $Y>(IOSL-8) D HEAD Q:$D(APCLQUIT)
  1. W !!!,"Number of patients included on this",!
  1. W "report who had a prescription for Vitamin K",!
  1. W "during the report date range:",?40,$J($$C(APCLRPVK,0,8),12),?55,$$PER(APCLRPVK,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
  1. W !?3,"Patients who received Vitamin K this month:",!
  1. D SUBHEAD2
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD2
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .;NOW DISPLAY INDICATIONS - ALL DXS IN TIME PERIOD
  1. .I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT) D SUBHEAD2
  1. .W ?3,"Date of Last Vitamin K prescription: ",$$D1^APCHSMU(^XTMP("APCLACG",APCLJOB,APCLBTH,"VITK",DFN)),!
  1. .K APCLD
  1. .S %=DFN_"^ALL DX [BJPC AC THRPY INDIC DXS;DURING "_APCLBD_"-"_APCLED,E=$$START1^APCLDF(%,"APCLD(")
  1. .W ?3,"Indication for Anticoag Therapy:"
  1. .S X=0 F S X=$O(APCLD(X)) Q:X'=+X W " ",$P(APCLD(X),U,2)
  1. .W !
  1. MONT ;
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "are within their INR Goal range and were",!
  1. W "monitored this month",?40,$J($$C(APCLRPMI,0,8),12),?55,$$PER(APCLRPMI,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "are within their INR Goal range but were",!
  1. W "NOT monitored this month",?40,$J($$C(APCLRPNI,0,8),12),?55,$$PER(APCLRPNI,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "who are NOT within their INR Goal range but",!
  1. W "were monitored this month",?40,$J($$C(APCLRPMN,0,8),12),?55,$$PER(APCLRPMN,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "who are NOT within their INR Goal range and",!
  1. W "were NOT monitored this month",?40,$J($$C(APCLRPNN,0,8),12),?55,$$PER(APCLRPNN,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "who were monitored this month but their INR",!
  1. W "in goal status could not be determined",?40,$J($$C(APCLRPMU,0,8),12),?55,$$PER(APCLRPMU,APCLRPWR)," (of Rep/War Pop)",!
  1. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1. W !,"Number of patients included on this",!
  1. W "report who had a prescription for Warfarin,",!
  1. W "who were NOT monitored this month and their INR",!
  1. W "in goal status could not be determined",?40,$J($$C(APCLRPNU,0,8),12),?55,$$PER(APCLRPNU,APCLRPWR)," (of Rep/War Pop)",!
  1. ;
  1. LISTS ;
  1. I '$D(APCLLIST) G DONE
  1. I $D(APCLLIST(1)) D LIST1
  1. G:$D(APCLQUIT) DONE
  1. I $D(APCLLIST(2)) D LIST2
  1. G:$D(APCLQUIT) DONE
  1. I $D(APCLLIST(3)) D LIST3
  1. G:$D(APCLQUIT) DONE
  1. I $D(APCLLIST(4)) D LIST4
  1. G:$D(APCLQUIT) DONE
  1. I $D(APCLLIST(5)) D LIST5
  1. Q:$D(APCLQUIT)
  1. ;
  1. DONE ;
  1. Q
  1. LIST1 ;all patient in ^TMP($J,"PATIENTS"
  1. S APCLSHD="Patient Population: All patients in the Report Population"
  1. D HEAD
  1. Q:$D(APCLQUIT)
  1. I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS")) W !!,"No data to report." Q
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"PATIENTS",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .Q
  1. Q
  1. LIST2 ;all patient in ^TMP($J,"PATIENTS"
  1. S APCLSHD="Patient Population: Only patients in INR Goal Range who were monitored this month."
  1. D HEAD
  1. Q:$D(APCLQUIT)
  1. I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE")) W !!,"No data to report." Q
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .Q
  1. Q
  1. LIST3 ;all patient in ^TMP($J,"PATIENTS"
  1. S APCLSHD="Patient Population: Only patients in INR Goal Range who were NOT monitored this month."
  1. D HEAD
  1. Q:$D(APCLQUIT)
  1. I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE")) W !!,"No data to report." Q
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .Q
  1. Q
  1. LIST4 ;all patient in ^TMP($J,"PATIENTS"
  1. S APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were monitored this month."
  1. D HEAD
  1. Q:$D(APCLQUIT)
  1. I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE")) W !!,"No data to report." Q
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"MONT NOT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .Q
  1. Q
  1. LIST5 ;all patient in ^TMP($J,"PATIENTS"
  1. S APCLSHD="Patient Population: Only patients NOT in INR Goal Range who were NOT monitored this month."
  1. D HEAD
  1. Q:$D(APCLQUIT)
  1. I '$D(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE")) W !!,"No data to report." Q
  1. S DFN=0 F S DFN=$O(^XTMP("APCLACG",APCLJOB,APCLBTH,"NOT MONT NOT IN RANGE",DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
  1. .I $Y>(IOSL-3) D HEAD Q:$D(APCLQUIT) D SUBHEAD3
  1. .W !?1,$E($P(^DPT(DFN,0),U),1,20),?23,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$D1^APCHSMU($$DOB^AUPNPAT(DFN))
  1. .W ?43,$P($$INRGOAL(DFN,APCLED),U,1)
  1. .S APCLL=$$LASTINR(DFN,APCLBD,APCLED)
  1. .W ?56,$P(APCLL,U,3),?66,$$D1^APCHSMU($P(APCLL,U,1)),!
  1. .Q
  1. Q
  1. LASTINR(P,BD,ED) ;EP
  1. NEW APCLVAL
  1. S APCLVAL=$$LASTLAB^APCLAPIU(P,BD,ED,,$O(^ATXLAB("B","BJPC INR LAB TESTS",0)),,$O(^ATXAX("B","BJPC INR LAB LOINCS",0)),"A","INR")
  1. Q APCLVAL
  1. SUBHEAD2 ;
  1. W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"Last INR",?66,"Last INR Date",!?62,"(in rpt period)",!
  1. W APCL80S,!
  1. Q
  1. SUBHEAD1 ;
  1. W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"GOAL INR",?56,"INR Value",?66,"INR Date",!
  1. W APCL80S,!
  1. Q
  1. SUBHEAD3 ;
  1. W !?1,"NAME",?25,"HRN",?32,"DOB",?43,"INR GOAL",?56,"LAST INR",?66,"LAST INR DATE",!,?46,"----- last in report period -----",!
  1. W APCL80S,!
  1. Q
  1. MRGOAL(P) ;PEP - most recent INR goal and date
  1. I $G(P)="" Q ""
  1. I '$D(^AUPNVACG("AA",P)) Q ""
  1. NEW X,Y,D,R,I,Z,S
  1. S R=""
  1. S D=0 F S D=$O(^AUPNVACG("AA",P,D)) Q:D'=+D!(R]"") D
  1. .S X=0 F S X=$O(^AUPNVACG("AA",P,D,X)) Q:X'=+X!(R]"") D
  1. ..S I=0 F S I=$O(^AUPNVACG("AA",P,D,X,I)) Q:I'=+I D
  1. ...Q:$P($G(^AUPNVACG(I,0)),U,4)=""
  1. ...Q:$P($G(^AUPNVACG(I,1)),U,1) ;entered in error
  1. ...S Z=$P(^AUPNVACG(I,0),U,4)
  1. ...I Z=3 S S=$P(^AUPNVACG(I,0),U,5)_" - "_$P(^AUPNVACG(I,0),U,6)
  1. ...I Z'=3 S S=$$VAL^XBDIQ1(9000010.51,I,.04)
  1. ...S R=$$VD^APCLV($P(^AUPNVACG(I,0),U,3))_"^"_S
  1. Q R
  1. INRGOAL(P,A) ;EP - inr goal documented on or before this date
  1. I $G(P)="" Q ""
  1. I '$D(^AUPNVACG("AA",P)) Q ""
  1. NEW X,Y,D,R,I,Z,S,J
  1. S R=""
  1. S D=0 F S D=$O(^AUPNVACG("AA",P,D)) Q:D'=+D!(R]"") D
  1. .S X=0 F S X=$O(^AUPNVACG("AA",P,D,X)) Q:X'=+X!(R]"") D
  1. ..S I=0 F S I=$O(^AUPNVACG("AA",P,D,X,I)) Q:I'=+I D
  1. ...Q:$P($G(^AUPNVACG(I,0)),U,4)=""
  1. ...Q:$P($G(^AUPNVACG(I,1)),U,1) ;entered in error
  1. ...S J=9999999-X
  1. ...I J>A Q
  1. ...S Z=$P(^AUPNVACG(I,0),U,4)
  1. ...I Z=3 S S=$P(^AUPNVACG(I,0),U,5)_" - "_$P(^AUPNVACG(I,0),U,6)
  1. ...I Z'=3 S S=$$VAL^XBDIQ1(9000010.51,I,.04)
  1. ...S R=S ;_" ("_$$D1^APCHSACG($$VD^APCLV($P(^AUPNVACG(I,0),U,3)))
  1. Q R
  1. C(X,X2,X3) ;
  1. I $G(X3)="" S X3=12
  1. D COMMA^%DTC
  1. Q $$STRIP^XLFSTR(X," ")
  1. PER(N,D) ;return % of n/d
  1. I 'D Q "0.0%"
  1. NEW Z
  1. S Z=N/D,Z=Z*100,Z=$J(Z,3,1)
  1. Q $$STRIP^XLFSTR(Z," ")_"%"
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
  1. HEAD1 ;
  1. W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1. W $$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
  1. W !,$$CTR($$LOC())
  1. W !!,$$CTR("ANTICOAGULATION INR MANAGEMENT REPORT",80),!
  1. I $G(APCLSHD)]"" W !,"PATIENT LIST",!,$$CTR(APCLSHD),!
  1. W APCL80S,!
  1. I $G(APCLSHD)]"" D SUBHEAD3
  1. Q
  1. ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. EOP ;EP - End of page.
  1. Q:$E(IOST)'="C"
  1. Q:$D(ZTQUEUED)!'(IOT["TRM")!$D(IO("S"))
  1. NEW DIR
  1. K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1. S DIR(0)="E" D ^DIR
  1. Q
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------