APCLYV1.m

APCLYV1 ; IHS/CMI/LAB - PRINT LIST OF CO & DEPEN VISITS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;This report lists outpatient and inpatients visits to a

 ;facility by commissioned officers and their dependents

 ;

 W:$D(IOF) @IOF W !!?15,"COMMISSIONED OFFICERS & DEPENDENTS VISITS REPORT",!!

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

 ;

 ;

VST ;

 S DIR(0)="S^1:Outpatient Visits Only;2:Inpatient Visits Only;3:Dental Visits Only;4:All Visits",DIR("A")="Select" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) GETDATES

 I Y=1!(Y=4) S APCLOP=""

 I Y=2!(Y=4) S APCLIP=""

 I Y=3!(Y=4) S APCLDEN=""

 ;

 W !!,$C(7),$C(7),"THIS REPORT MUST BE PRINTED ON 132 COLUMN PAPER OR ON A PRINTER THAT IS",!,"SET UP FOR CONDENSED PRINT!!!",!,"IF YOU DO NOT HAVE SUCH A PRINTER AVAILABLE - SEE YOUR SITE MANAGER.",!

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G VST

 S XBRP="^APCLYV12",XBRC="^APCLYV11",XBNS="APCL",XBRX="END^APCLYV1"

 D ^XBDBQUE

 D END

 Q

END K Y,APCLBD,APCLED,APCLIP,APCLOP,APCLDEN,ZTSK,APCLEDT

 K APCLBD,APCLDEN,APCLED,APCLIP,APCLOP,APCLSD,APCLBT,APCLCO,APCLDEN,APCLDEP,APCLDSCH,APCLED,APCLHRCN,APCLIDFN,APCLII,APCLIP,APCLJOB,APCLNAME,APCLOP,APCLPAT,APCLRET,APCLRETD,APCLSD,APCLSTR,APCLVDFN,APCLVEDT

 K APLCBEN,APCLBENP,APCLCHMP,APCLFAC,APCLJOB,APCLNAME,APCLSSN,APCLSTOP,APCLSTR1,APCLSUB,APCLTOT,APCLVDT,APCLBD,APCLCO,APCLCOFL

APCLYV1   ; IHS/CMI/LAB - PRINT LIST OF CO & DEPEN VISITS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;This report lists outpatient and inpatients visits to a

 +3       ;facility by commissioned officers and their dependents

 +4       ;

 +5        IF $DATA(IOF)

               WRITE @IOF

           WRITE !!?15,"COMMISSIONED OFFICERS & DEPENDENTS VISITS REPORT",!!

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       ;

VST       ;

 +1        SET DIR(0)="S^1:Outpatient Visits Only;2:Inpatient Visits Only;3:Dental Visits Only;4:All Visits"

           SET DIR("A")="Select"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO GETDATES

 +3        IF Y=1!(Y=4)

               SET APCLOP=""

 +4        IF Y=2!(Y=4)

               SET APCLIP=""

 +5        IF Y=3!(Y=4)

               SET APCLDEN=""

 +6       ;

 +7        WRITE !!,$CHAR(7),$CHAR(7),"THIS REPORT MUST BE PRINTED ON 132 COLUMN PAPER OR ON A PRINTER THAT IS",!,"SET UP FOR CONDENSED PRINT!!!",!,"IF YOU DO NOT HAVE SUCH A PRINTER AVAILABLE - SEE YOUR SITE MANAGER.",!

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO VST

 +3        SET XBRP="^APCLYV12"

           SET XBRC="^APCLYV11"

           SET XBNS="APCL"

           SET XBRX="END^APCLYV1"

 +4        DO ^XBDBQUE

 +5        DO END

 +6        QUIT 

END        KILL Y,APCLBD,APCLED,APCLIP,APCLOP,APCLDEN,ZTSK,APCLEDT

 +1        KILL APCLBD,APCLDEN,APCLED,APCLIP,APCLOP,APCLSD,APCLBT,APCLCO,APCLDEN,APCLDEP,APCLDSCH,APCLED,APCLHRCN,APCLIDFN,APCLII,APCLIP,APCLJOB,APCLNAME,APCLOP,APCLPAT,APCLRET,APCLRETD,APCLSD,APCLSTR,APCLVDFN,APCLVEDT

 +2        KILL APLCBEN,APCLBENP,APCLCHMP,APCLFAC,APCLJOB,APCLNAME,APCLSSN,APCLSTOP,APCLSTR1,APCLSUB,APCLTOT,APCLVDT,APCLBD,APCLCO,APCLCOFL