APCLYV3.m

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