- AZXAPUR ; IHS/PHXAO/TMJ - ROI CLOSED DISCLOSURES BY PURPOSE (BY DATE RANGE) ;
- ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002
- ;
- ;
- ASK ;Ask For Date Range
- ;
- ;
- BD ;get beginning date
- W !! S DIR(0)="D^::EP",DIR("A")="Enter beginning ROI Initiated 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 ROI 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 !
- ;
- PRINT ;PRINT CLOSED DISCLOSURES BY DATE
- ;W !
- S FLDS="[AZXA PURPOSE SUBTOTAL PRINT]",BY="'(#.01),INTERNAL(#.08)=""C"",+.07",DIC="^AZXAREC(",L=0
- S FR=AZXABD,TO=AZXAED
- K DHIT,DIOEND,DIOBEG
- D EN1^DIP
- END ;
- K AZXABD,AZXAED,X,DD0,B Q
- AZXAPUR ; IHS/PHXAO/TMJ - ROI CLOSED DISCLOSURES BY PURPOSE (BY DATE RANGE) ;
- +1 ;;2.0;RELEASE OF INFORMATION;;FEB 21, 2002
- +2 ;
- +3 ;
- ASK ;Ask For Date Range
- +1 ;
- +2 ;
- BD ;get beginning date
- +1 WRITE !!
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter beginning ROI Initiated 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 ROI 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 ;
- PRINT ;PRINT CLOSED DISCLOSURES BY DATE
- +1 ;W !
- +2 SET FLDS="[AZXA PURPOSE SUBTOTAL PRINT]"
- SET BY="'(#.01),INTERNAL(#.08)=""C"",+.07"
- SET DIC="^AZXAREC("
- SET L=0
- +3 SET FR=AZXABD
- SET TO=AZXAED
- +4 KILL DHIT,DIOEND,DIOBEG
- +5 DO EN1^DIP
- END ;
- +1 KILL AZXABD,AZXAED,X,DD0,B
- QUIT