APCLYV3 ; IHS/CMI/LAB - CLINIC VISITS BY DATE RANGE WITH POV ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;This report is to be used to list visits by clinic
;
W:$D(IOF) @IOF W !!?20,"LISTING OF CLINIC VISITS WITH ICD CODES",!!
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G END
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
;
;
CLINIC ;
S DIR(0)="S^1:Print for ALL clinics;2:Print for ONE clinic;3:Print visits with no clinic code",DIR("A")=" Selection" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) GETDATES
I Y=1 S APCLCL="A" G ICD
I Y=3 S APCLCL="N" G ICD
K DIC S DIC=40.7,DIC(0)="AEQMZ",DIC("A")="Which Clinic: " D ^DIC
G CLINIC:Y<1 S APCLCL=+Y
ICD ;
W !!
K APCLARR,APCLARRC
S DIR(0)="S^1:Print all Visits;2:Print Visits for a range of POV ICD codes;3:Print Visits for a range of Procedure ICD codes",DIR("A")=" Which visits should be printed" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) CLINIC
S APCLICD=Y
I APCLICD=1 S (APCLBICD,APCLEICD)="" G LOC
LKUP ;
;GET CODING SYSTEM FIRST
S APCDSYS=""
W !,"You must enter the coding system from which you want to enter a code,",!,"or range of codes.",!
K DIC S DIC="^ICDS(",DIC("S")="I $P(^(0),U,3)="_$S(APCLICD=2:80,1:80.1)_"",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G ICD
S APCLSYS=+Y
K DIC S DIC=$S(APCLICD=2:80,1:80.1) S DIC(0)="AEMQZ"
S DIC("A")="Enter the beginning ICD code: ",ICDSYS=APCLSYS D ^DIC G ICD:Y<1
S APCLBICD=$P(Y(0),"^"),DIC("A")="Enter the ending ICD code: ",ICDSYS=APCLSYS D ^DIC
G ICD:Y<1 S APCLEICD=$P(Y(0),"^")
;I APCLEICD<APCLBICD W $C(7),!,"Ending code must be greater than or equal to beginning code" G LKUP
K APCLARR,APCLARRC
D LST^ATXAPI(APCLSYS,$S(APCLICD=2:80,1:80.1),APCLBICD_"-"_APCLEICD,"CODE","APCLARR")
I $O(APCLARR(""))="" W !!,"Invalid range. Try again." G LKUP
S X="" F S X=$O(APCLARR(X)) Q:X="" D
.S APCLARRC($P(APCLARR(X),U,1))=""
.Q
LOC ;
S DIR(0)="YO",DIR("A")="Include visits from ALL Locations",DIR("?")="If you wish to include visits from ALL locations answer Yes. If you wish to tabulate for only one location of encounter enter NO." D ^DIR K DIR
G:$D(DIRUT) BD
I Y=1 S APCLLOC="" G PROV
LOC1 ;enter location
S DIC("A")="Which Location: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 LOC
S APCLLOC=+Y
PROV ;
S DIR(0)="YO",DIR("A")="Do you wish include visits to ALL Providers",DIR("?")="If you wish to include visits to ALL providers answer YES. answer Yes. If you wish to tabulate for visits to ONE provider only enter NO." D ^DIR K DIR
G:$D(DIRUT) LOC
I Y=1 S APCLPROV="" G ZIS
S DIC("A")="Which Provider: ",DIC=$S($P(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,"),DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 LOC
S APCLPROV=+Y
ZIS ;
S XBRC="CALC^APCLYV31",XBRP="^APCLYV32",XBNS="APCL",XBRX="END^APCLYV3"
D ^XBDBQUE
END K Y,APCLBD,APCLED,APCLCL,APCLICD,APCLBICD,APCLEICD,ZTSK,ZTQUEUED,%DT,APCLLOC,APCLBT,APCLSD,APCLJOB,APCLPROV,APCLFOUN,APCLDFN
K APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,DA,DFN,%DT,%T,%Y,APCLAGE,G,POP
K APCLNAME,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,APCLSTR
K APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y
K DIC,DOB,DR,APCLHRCN,I,LKPRINT,SEX,SFX,APCLSTR,X,APCLCLX,APCLCL,APCLPGRD
K APCLVGRA,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG
Q
APCLYV3 ; IHS/CMI/LAB - CLINIC VISITS BY DATE RANGE WITH POV ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;This report is to be used to list visits by clinic
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
WRITE !!?20,"LISTING OF CLINIC VISITS WITH ICD CODES",!!
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO END
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCLBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLED=Y
+4 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+5 ;
+6 ;
CLINIC ;
+1 SET DIR(0)="S^1:Print for ALL clinics;2:Print for ONE clinic;3:Print visits with no clinic code"
SET DIR("A")=" Selection"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETDATES
+3 IF Y=1
SET APCLCL="A"
GOTO ICD
+4 IF Y=3
SET APCLCL="N"
GOTO ICD
+5 KILL DIC
SET DIC=40.7
SET DIC(0)="AEQMZ"
SET DIC("A")="Which Clinic: "
DO ^DIC
+6 IF Y<1
GOTO CLINIC
SET APCLCL=+Y
ICD ;
+1 WRITE !!
+2 KILL APCLARR,APCLARRC
+3 SET DIR(0)="S^1:Print all Visits;2:Print Visits for a range of POV ICD codes;3:Print Visits for a range of Procedure ICD codes"
SET DIR("A")=" Which visits should be printed"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO CLINIC
+5 SET APCLICD=Y
+6 IF APCLICD=1
SET (APCLBICD,APCLEICD)=""
GOTO LOC
LKUP ;
+1 ;GET CODING SYSTEM FIRST
+2 SET APCDSYS=""
+3 WRITE !,"You must enter the coding system from which you want to enter a code,",!,"or range of codes.",!
+4 KILL DIC
SET DIC="^ICDS("
SET DIC("S")="I $P(^(0),U,3)="_$SELECT(APCLICD=2:80,1:80.1)_""
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y=-1
GOTO ICD
+6 SET APCLSYS=+Y
+7 KILL DIC
SET DIC=$SELECT(APCLICD=2:80,1:80.1)
SET DIC(0)="AEMQZ"
+8 SET DIC("A")="Enter the beginning ICD code: "
SET ICDSYS=APCLSYS
DO ^DIC
IF Y<1
GOTO ICD
+9 SET APCLBICD=$PIECE(Y(0),"^")
SET DIC("A")="Enter the ending ICD code: "
SET ICDSYS=APCLSYS
DO ^DIC
+10 IF Y<1
GOTO ICD
SET APCLEICD=$PIECE(Y(0),"^")
+11 ;I APCLEICD<APCLBICD W $C(7),!,"Ending code must be greater than or equal to beginning code" G LKUP
+12 KILL APCLARR,APCLARRC
+13 DO LST^ATXAPI(APCLSYS,$SELECT(APCLICD=2:80,1:80.1),APCLBICD_"-"_APCLEICD,"CODE","APCLARR")
+14 IF $ORDER(APCLARR(""))=""
WRITE !!,"Invalid range. Try again."
GOTO LKUP
+15 SET X=""
FOR
SET X=$ORDER(APCLARR(X))
IF X=""
QUIT
Begin DoDot:1
+16 SET APCLARRC($PIECE(APCLARR(X),U,1))=""
+17 QUIT
End DoDot:1
LOC ;
+1 SET DIR(0)="YO"
SET DIR("A")="Include visits from ALL Locations"
SET DIR("?")="If you wish to include visits from ALL locations answer Yes. If you wish to tabulate for only one location of encounter enter NO."
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO BD
+3 IF Y=1
SET APCLLOC=""
GOTO PROV
LOC1 ;enter location
+1 SET DIC("A")="Which Location: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO LOC
+2 SET APCLLOC=+Y
PROV ;
+1 SET DIR(0)="YO"
SET DIR("A")="Do you wish include visits to ALL Providers"
SET DIR("?")="If you wish to include visits to ALL providers answer YES. answer Yes. If you wish to tabulate for visits to ONE provider only enter NO."
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO LOC
+3 IF Y=1
SET APCLPROV=""
GOTO ZIS
+4 SET DIC("A")="Which Provider: "
SET DIC=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,")
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO LOC
+5 SET APCLPROV=+Y
ZIS ;
+1 SET XBRC="CALC^APCLYV31"
SET XBRP="^APCLYV32"
SET XBNS="APCL"
SET XBRX="END^APCLYV3"
+2 DO ^XBDBQUE
END KILL Y,APCLBD,APCLED,APCLCL,APCLICD,APCLBICD,APCLEICD,ZTSK,ZTQUEUED,%DT,APCLLOC,APCLBT,APCLSD,APCLJOB,APCLPROV,APCLFOUN,APCLDFN
+1 KILL APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,DA,DFN,%DT,%T,%Y,APCLAGE,G,POP
+2 KILL APCLNAME,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,APCLSTR
+3 KILL APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y
+4 KILL DIC,DOB,DR,APCLHRCN,I,LKPRINT,SEX,SFX,APCLSTR,X,APCLCLX,APCLCL,APCLPGRD
+5 KILL APCLVGRA,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG
+6 QUIT
