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