APCLREDU ; IHS/CMI/LAB - education delimted file for use in excel ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
START ;
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will create a delimited output file of all visits on which patient",!,"education was done. This report is to be used by uploading the data file",!,"into EXCEL or some other software package.",!!
D EXIT
DATES K APCLED,APCLBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 EXIT S APCLBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR G:Y<1 EXIT S APCLED=Y
;
I APCLED<APCLBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
;
CLINIC ;
W !!
S APCLCL="" S APCLCLIN=""
S DIR(0)="Y",DIR("A")="Include ALL outpatient clinics",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) DATES
I Y=1 G HL
;
CLINIC1 ;Get Multiple Clinics in Search
K APCLCLNT
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OPPS - QMAN NOT CURRENT - QUITTING" G EXIT
D PEP^AMQQGTX0(+Y,"APCLCLNT(")
I '$D(APCLCLNT) G CLINIC
I $D(APCLCLNT("*")) K APCLCLNT
G CLINIC:Y<1
;
HL ;
K APCLHL
S DIR(0)="Y",DIR("A")="Include all HOSPITAL LOCATIONS",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G CLINIC
I Y=1 G TOPIC
S APCLQ="" K APCLHL F D Q:APCLQ
.K DIR S DIR(0)="9000010,.22",DIR("A")="Which Hospital Location" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCLQ=1 Q
.S APCLHL(+Y)=""
;
TOPIC ;
K APCLEDT,APCLEDTL
S APCLEDT=""
S DIR(0)="SO^A:Any Education Topic recorded;V:Visits with or w/o an Education Topic;S:Selected Education Topics",DIR("A")="Includes visits with",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G HL
I Y="A" S APCLEDT="A" G ZIS
I Y="V" S APCLEDT="V" G ZIS
I Y="S" S APCLEDT="S"
TOPIC1 ;
K APCLEDTL
S X="PATIENT ED TOPIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OPPS - QMAN NOT CURRENT - QUITTING" G EXIT
D PEP^AMQQGTX0(+Y,"APCLEDTL(")
I '$D(APCLEDTL) G TOPIC
I $D(APCLEDTL("*")) K APCLEDTL
G TOPIC:Y<1
;
ZIS ;call to XBDBQUE
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G TOPIC
S XBRP="PRINT^APCLREDU",XBRC="",XBRX="EXIT^APCLREDU",XBNS="APCL"
D ^XBDBQUE
D EXIT
Q
EXIT ;clean up and exit
D EN^XBVK("APCL")
D ^XBFMK
D KILL^AUPNPAT
Q
PRINT ;EP - called from xbdbque
D HEADER
S APCLVTOT=0,APCLPTOT=0,APCLPEDU=0
K ^TMP($J)
F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD'=+APCLSD!($P(APCLSD,".")>APCLED) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("B",APCLSD,APCLV)) Q:APCLV'=+APCLV D
..Q:'$D(^AUPNVSIT(APCLV,0))
..Q:$P(^AUPNVSIT(APCLV,0),U,11)
..S DFN=$P(^AUPNVSIT(APCLV,0),U,5)
..Q:DFN=""
..Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
..I $D(APCLCLNT) S X=$P(^AUPNVSIT(APCLV,0),U,8) Q:X="" Q:'$D(APCLCLNT(X))
..I $D(APCLHL) S X=$P(^AUPNVSIT(APCLV,0),U,22) Q:X="" Q:'$D(APCLHL(X))
..I APCLEDT="A",'$O(^AUPNVPED("AD",APCLV,0)) Q ;want any education topic and this visit has none
..I APCLEDT="S" D Q:'APCLG
...S APCLG=""
...S X=$O(^AUPNVPED("AD",APCLV,X)) Q:X'=+X S T=$P(^AUPNVPED(X,0),U) I $D(APCLEDTL(T)) S APCLG=1
...Q
..S APCLVTOT=APCLVTOT+1
..I '$D(^TMP($J,"PAT","USED",DFN)) S APCLPTOT=APCLPTOT+1,^TMP($J,"PAT","USED",DFN)=""
..I APCLEDT="V",'$O(^AUPNVPED("AD",APCLV,0)) S APCLX="" D SET Q
..I '$D(^TMP($J,"PAT","EDUC",DFN)) S APCLPEDU=APCLPEDU+1,^TMP($J,"PAT","EDUC",DFN)=""
..S APCLX=0 F S APCLX=$O(^AUPNVPED("AD",APCLV,APCLX)) Q:APCLX'=+APCLX D
...I APCLEDT="A" D SET Q
...I APCLEDT="S" S T=$P(^AUPNVPED(APCLX,0),U) I $D(APCLEDTL(T)) D SET Q
...I APCLEDT="V" D SET Q
W !,"Total # of visits meeting criteria"_U_APCLVTOT
W !,"Total # of patients for these visits"_U_APCLPTOT
W !,"Total # of these patients w/education"_U_APCLPEDU
Q
SET ;
S D=$P($P(^AUPNVSIT(APCLV,0),U),".")
S APCLR=APCLV_U_$P(^DPT(DFN,0),U)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$$FMTE^XLFDT($$DOB^AUPNPAT(DFN))_U_$$AGE^AUPNPAT(DFN,D)_U_$$FMTE^XLFDT(D)_U_$$CLINIC^APCLV(APCLV,"C")_U_$$VAL^XBDIQ1(9000010,APCLV,.22)
I APCLX]"" S APCLR=APCLR_U_$$VAL^XBDIQ1(9999999.09,$P(^AUPNVPED(APCLX,0),U),1)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.05)_U_$$PROVCLSC^XBFUNC1($P(^AUPNVPED(APCLX,0),U,5))_U_$$VAL^XBDIQ1(9000010.16,APCLX,.01)
I APCLX]"" S APCLR=APCLR_U_$$VAL^XBDIQ1(9000010.16,APCLX,.06)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.07)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.08)
I APCLX]"" F APCLF=.13,.14,.09,.11,1101 S APCLR=APCLR_U_$$VAL^XBDIQ1(9000010.16,APCLX,APCLF)
S APCLR=APCLR_U_$$VAL^XBDIQ1(9000001,DFN,.14)
W !,APCLR
Q
W "DATE RANGE: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED)
I '$D(APCLCLNT) W !,"ALL CLINICS"
I $O(APCLCLNT(0)) S X=0 F S X=$O(APCLCLNT(X)) Q:X'=+X W !,$P(^DIC(40.7,X,0),U,2)_" ;"
I '$D(APCLHL) W !,"ALL HOSPITAL LOCATIONS"
I $O(APCLHL(0)) S X=0 F S X=$O(APCLHL(X)) Q:X'=+X W !,$P(^SC(X,0),U,2)_" ;"
;I '$D(APCLDISC) W !,"ALL DISCIPLINES"
;I $O(APCLDISC(0)) S X=0 F S X=$O(APCLDISC(X)) Q:X'=+X W !,$P($G(^DIC(7,X,9999999)),U,1)_" ;"
W !,"VISIT IEN^PATIENT NAME^CHART NUMBER^DATE OF BIRTH^AGE^VISIT DATE^CLINIC TYPE^HOSPITAL LOCATION^EDUCATION TOPIC^EDUCATION PROVIDER^EDUCATION PROVIDER CLASS CODE"
W "^TOPIC FULL NAME^LEVEL OF UNDERSTANDING^IND/GRP^MINUTES^GOAL STATUS^OBJECTIVES MET^CPT CODE^COMMENT^DESIGNATED PRIMARY CARE PROVIDER"
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")
;----------
APCLREDU ; IHS/CMI/LAB - education delimted file for use in excel ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
START ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will create a delimited output file of all visits on which patient",!,"education was done. This report is to be used by uploading the data file",!,"into EXCEL or some other software package.",!!
+5 DO EXIT
DATES KILL APCLED,APCLBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
GOTO EXIT
SET APCLBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
GOTO EXIT
SET APCLED=Y
+5 ;
+6 IF APCLED<APCLBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 SET APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+9 ;
CLINIC ;
+1 WRITE !!
+2 SET APCLCL=""
SET APCLCLIN=""
+3 SET DIR(0)="Y"
SET DIR("A")="Include ALL outpatient clinics"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO DATES
+5 IF Y=1
GOTO HL
+6 ;
CLINIC1 ;Get Multiple Clinics in Search
+1 KILL APCLCLNT
+2 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OPPS - QMAN NOT CURRENT - QUITTING"
GOTO EXIT
+3 DO PEP^AMQQGTX0(+Y,"APCLCLNT(")
+4 IF '$DATA(APCLCLNT)
GOTO CLINIC
+5 IF $DATA(APCLCLNT("*"))
KILL APCLCLNT
+6 IF Y<1
GOTO CLINIC
+7 ;
HL ;
+1 KILL APCLHL
+2 SET DIR(0)="Y"
SET DIR("A")="Include all HOSPITAL LOCATIONS"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO CLINIC
+4 IF Y=1
GOTO TOPIC
+5 SET APCLQ=""
KILL APCLHL
FOR
Begin DoDot:1
+6 KILL DIR
SET DIR(0)="9000010,.22"
SET DIR("A")="Which Hospital Location"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
SET APCLQ=1
QUIT
+8 SET APCLHL(+Y)=""
End DoDot:1
IF APCLQ
QUIT
+9 ;
TOPIC ;
+1 KILL APCLEDT,APCLEDTL
+2 SET APCLEDT=""
+3 SET DIR(0)="SO^A:Any Education Topic recorded;V:Visits with or w/o an Education Topic;S:Selected Education Topics"
SET DIR("A")="Includes visits with"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO HL
+5 IF Y="A"
SET APCLEDT="A"
GOTO ZIS
+6 IF Y="V"
SET APCLEDT="V"
GOTO ZIS
+7 IF Y="S"
SET APCLEDT="S"
TOPIC1 ;
+1 KILL APCLEDTL
+2 SET X="PATIENT ED TOPIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OPPS - QMAN NOT CURRENT - QUITTING"
GOTO EXIT
+3 DO PEP^AMQQGTX0(+Y,"APCLEDTL(")
+4 IF '$DATA(APCLEDTL)
GOTO TOPIC
+5 IF $DATA(APCLEDTL("*"))
KILL APCLEDTL
+6 IF Y<1
GOTO TOPIC
+7 ;
ZIS ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO TOPIC
+3 SET XBRP="PRINT^APCLREDU"
SET XBRC=""
SET XBRX="EXIT^APCLREDU"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
EXIT ;clean up and exit
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 DO KILL^AUPNPAT
+4 QUIT
PRINT ;EP - called from xbdbque
+1 DO HEADER
+2 SET APCLVTOT=0
SET APCLPTOT=0
SET APCLPEDU=0
+3 KILL ^TMP($JOB)
+4 FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD'=+APCLSD!($PIECE(APCLSD,".")>APCLED)
QUIT
Begin DoDot:1
+5 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("B",APCLSD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+6 IF '$DATA(^AUPNVSIT(APCLV,0))
QUIT
+7 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+8 SET DFN=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+9 IF DFN=""
QUIT
+10 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+11 IF $DATA(APCLCLNT)
SET X=$PIECE(^AUPNVSIT(APCLV,0),U,8)
IF X=""
QUIT
IF '$DATA(APCLCLNT(X))
QUIT
+12 IF $DATA(APCLHL)
SET X=$PIECE(^AUPNVSIT(APCLV,0),U,22)
IF X=""
QUIT
IF '$DATA(APCLHL(X))
QUIT
+13 ;want any education topic and this visit has none
IF APCLEDT="A"
IF '$ORDER(^AUPNVPED("AD",APCLV,0))
QUIT
+14 IF APCLEDT="S"
Begin DoDot:3
+15 SET APCLG=""
+16 SET X=$ORDER(^AUPNVPED("AD",APCLV,X))
IF X'=+X
QUIT
SET T=$PIECE(^AUPNVPED(X,0),U)
IF $DATA(APCLEDTL(T))
SET APCLG=1
+17 QUIT
End DoDot:3
IF 'APCLG
QUIT
+18 SET APCLVTOT=APCLVTOT+1
+19 IF '$DATA(^TMP($JOB,"PAT","USED",DFN))
SET APCLPTOT=APCLPTOT+1
SET ^TMP($JOB,"PAT","USED",DFN)=""
+20 IF APCLEDT="V"
IF '$ORDER(^AUPNVPED("AD",APCLV,0))
SET APCLX=""
DO SET
QUIT
+21 IF '$DATA(^TMP($JOB,"PAT","EDUC",DFN))
SET APCLPEDU=APCLPEDU+1
SET ^TMP($JOB,"PAT","EDUC",DFN)=""
+22 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUPNVPED("AD",APCLV,APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:3
+23 IF APCLEDT="A"
DO SET
QUIT
+24 IF APCLEDT="S"
SET T=$PIECE(^AUPNVPED(APCLX,0),U)
IF $DATA(APCLEDTL(T))
DO SET
QUIT
+25 IF APCLEDT="V"
DO SET
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+26 WRITE !,"Total # of visits meeting criteria"_U_APCLVTOT
+27 WRITE !,"Total # of patients for these visits"_U_APCLPTOT
+28 WRITE !,"Total # of these patients w/education"_U_APCLPEDU
+29 QUIT
SET ;
+1 SET D=$PIECE($PIECE(^AUPNVSIT(APCLV,0),U),".")
+2 SET APCLR=APCLV_U_$PIECE(^DPT(DFN,0),U)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$$FMTE^XLFDT($$DOB^AUPNPAT(DFN))_U_$$AGE^AUPNPAT(DFN,D)_U_$$FMTE^XLFDT(D)_U_$$CLINIC^APCLV(APCLV,"C")_U_$$VAL^XBDIQ1(9000010,APCLV,.22)
+3 IF APCLX]""
SET APCLR=APCLR_U_$$VAL^XBDIQ1(9999999.09,$PIECE(^AUPNVPED(APCLX,0),U),1)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.05)_U_$$PROVCLSC^XBFUNC1($PIECE(^AUPNVPED(APCLX,0),U,5))_U_$$VAL^XBDIQ1(9000010.16,APCLX,.01)
+4 IF APCLX]""
SET APCLR=APCLR_U_$$VAL^XBDIQ1(9000010.16,APCLX,.06)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.07)_U_$$VAL^XBDIQ1(9000010.16,APCLX,.08)
+5 IF APCLX]""
FOR APCLF=.13,.14,.09,.11,1101
SET APCLR=APCLR_U_$$VAL^XBDIQ1(9000010.16,APCLX,APCLF)
+6 SET APCLR=APCLR_U_$$VAL^XBDIQ1(9000001,DFN,.14)
+7 WRITE !,APCLR
+8 QUIT
+1 WRITE "DATE RANGE: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED)
+2 IF '$DATA(APCLCLNT)
WRITE !,"ALL CLINICS"
+3 IF $ORDER(APCLCLNT(0))
SET X=0
FOR
SET X=$ORDER(APCLCLNT(X))
IF X'=+X
QUIT
WRITE !,$PIECE(^DIC(40.7,X,0),U,2)_" ;"
+4 IF '$DATA(APCLHL)
WRITE !,"ALL HOSPITAL LOCATIONS"
+5 IF $ORDER(APCLHL(0))
SET X=0
FOR
SET X=$ORDER(APCLHL(X))
IF X'=+X
QUIT
WRITE !,$PIECE(^SC(X,0),U,2)_" ;"
+6 ;I '$D(APCLDISC) W !,"ALL DISCIPLINES"
+7 ;I $O(APCLDISC(0)) S X=0 F S X=$O(APCLDISC(X)) Q:X'=+X W !,$P($G(^DIC(7,X,9999999)),U,1)_" ;"
+8 WRITE !,"VISIT IEN^PATIENT NAME^CHART NUMBER^DATE OF BIRTH^AGE^VISIT DATE^CLINIC TYPE^HOSPITAL LOCATION^EDUCATION TOPIC^EDUCATION PROVIDER^EDUCATION PROVIDER CLASS CODE"
+9 WRITE "^TOPIC FULL NAME^LEVEL OF UNDERSTANDING^IND/GRP^MINUTES^GOAL STATUS^OBJECTIVES MET^CPT CODE^COMMENT^DESIGNATED PRIMARY CARE PROVIDER"
+10 QUIT
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 ;----------
