- 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