BMCDKNA.m

BMCDKNA ; IHS/PHXAO/TMJ - DID NOT KEEP APPOINTMENT DKNA REPORT ; 

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 ;

 ;

START ;

 D INFORM

 ;

BD ;get beginning date

 W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning Referral Initiation Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G END

 S AZXABD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AZXABD_"::EP",DIR("A")="Enter ending Referral Initiation Date"  D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AZXAED=Y

 S X1=AZXABD,X2=-1 D C^%DTC S AZXASD=X

 W !

 ;

 ;

ASK ;Ask if a particular Reason Not Complete

 S AZXASTBD=1,AZXASTED=10

 W ! S DIR(0)="Y0",DIR("A")="Would you like to INCLUDE ONLY a particular Reason NOT Completed",DIR("B")="NO"

 S DIR("?")="To RESTRICT to a particular REASON NOT COMPLETED  - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) BD

 I 'Y G PRINT

STATUS ;RCIS REASON NOT COMPLETED

 S DIR(0)="90001,.16",DIR("A")="Enter the REASON NOT COMPLETED"

 K DA D ^DIR K DIR

 G:$D(DIRUT) ASK

 G:Y=0 ASK

 S AZXASTBD=Y,AZXASTED=Y

 ;

 ;

 ;

 ;

PRINT ;PRINT CLOSED DISCLOSURES BY DATE

 ;W !

 S FLDS="[BMC DKNA REPORT]",BY(0)="^BMCREF(""AF""," S L(0)=3,DIC="^BMCREF(",L=0

 S FR(0,1)=AZXASTBD,TO(0,1)=AZXASTED

 S FR(0,2)=AZXABD,TO(0,2)=AZXAED

 ;S FR(0,3)=AZXADKB,TO(0,3)=AZXADKE

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

END ;

 K AZXABD,AZXAED,X,DD0,B Q

 ;

INFORM ;User Report Information

 ;

 ;

 W !,?20,"*********RCIS-REASON NOT COMPLETED REPORT**********"

 W !!,"The Purpose of this report is to print a listing of Referrals"

 W " that have not been",! W "completed for a given date range.",!!  W "The User is asked to select a"

 W " specific REASON NOT COMPLETED or list ALL Reasons",!,"Completed."

 Q

BMCDKNA   ; IHS/PHXAO/TMJ - DID NOT KEEP APPOINTMENT DKNA REPORT ; 

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;

 +4       ;

START     ;

 +1        DO INFORM

 +2       ;

BD        ;get beginning date

 +1        WRITE !!

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter beginning Referral Initiation Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO END

 +3        SET AZXABD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AZXABD_"::EP"

           SET DIR("A")="Enter ending Referral Initiation Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AZXAED=Y

 +4        SET X1=AZXABD

           SET X2=-1

           DO C^%DTC

           SET AZXASD=X

 +5        WRITE !

 +6       ;

 +7       ;

ASK       ;Ask if a particular Reason Not Complete

 +1        SET AZXASTBD=1

           SET AZXASTED=10

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Would you like to INCLUDE ONLY a particular Reason NOT Completed"

           SET DIR("B")="NO"

 +3        SET DIR("?")="To RESTRICT to a particular REASON NOT COMPLETED  - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO BD

 +6        IF 'Y

               GOTO PRINT

STATUS    ;RCIS REASON NOT COMPLETED

 +1        SET DIR(0)="90001,.16"

           SET DIR("A")="Enter the REASON NOT COMPLETED"

 +2        KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO ASK

 +4        IF Y=0

               GOTO ASK

 +5        SET AZXASTBD=Y

           SET AZXASTED=Y

 +6       ;

 +7       ;

 +8       ;

 +9       ;

PRINT     ;PRINT CLOSED DISCLOSURES BY DATE

 +1       ;W !

 +2        SET FLDS="[BMC DKNA REPORT]"

           SET BY(0)="^BMCREF(""AF"","

           SET L(0)=3

           SET DIC="^BMCREF("

           SET L=0

 +3        SET FR(0,1)=AZXASTBD

           SET TO(0,1)=AZXASTED

 +4        SET FR(0,2)=AZXABD

           SET TO(0,2)=AZXAED

 +5       ;S FR(0,3)=AZXADKB,TO(0,3)=AZXADKE

 +6        KILL DHIT,DIOEND,DIOBEG

 +7        DO EN1^DIP

END       ;

 +1        KILL AZXABD,AZXAED,X,DD0,B

           QUIT 

 +2       ;

INFORM    ;User Report Information

 +1       ;

 +2       ;

 +3        WRITE !,?20,"*********RCIS-REASON NOT COMPLETED REPORT**********"

 +4        WRITE !!,"The Purpose of this report is to print a listing of Referrals"

 +5        WRITE " that have not been",!

           WRITE "completed for a given date range.",!!

           WRITE "The User is asked to select a"

 +6        WRITE " specific REASON NOT COMPLETED or list ALL Reasons",!,"Completed."

 +7        QUIT