source: FOIAVistA/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTSRCH.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DGBTSRCH ;ALB/SCK - SEARCH ROUTINE FOR INCOMPLETE DATA IN bt DISTANCE FILE;2/4/93 4/22/93
2 ;;1.0;Beneficiary Travel;;September 25, 2001
3 Q
4START ;
5 K DIR D HOME^%ZIS W @IOF
6START2 ;
7 W !!!?5,"List the Incomplete data found in the Beneficiary Distance File",!?5,"Any incomplete data should be corrected as soon as possible"
8 S OPT=$$OPTION G:$D(DIRUT) EXIT
9 S OPT=$S(Y=1:"REMARKS",Y=2:"ZIP",Y=3:"MILES",1:"") G:OPT']"" EXIT
10 L +^DGBT(392.1):3 I '$T W !!?5,*7,"File not available, Please try later..." G EXIT
11 D @OPT L -^DGBT(392.1) G START2
12EXIT ;
13 L -^DGBT(392.1)
14 K II,DIR,TO,FLDS,DHD,L,FR,OPT,X,Y,DR,DIRUT,DIS,DIC,BY,DA,DIS,DIOEND
15 Q
16REMARKS ; list cities and divisions with the additional information field set true
17 I $$REPORT=1 D
18 . K DIC S DIC="^DGBT(392.1,",DIC(0)="EMZ",L=0,BY="[DGBT REMARKS]",FLDS="[DGBT REMARKS]",DHD="Incomplete Additional Information Remarks in the Beneficiary Travel Distance FIle",DIOEND="D FTR^DGBTSRCH"
19 . D EN1^DIP K DIC
20 W !!,"Do you wish to update any Remark fields" Q:$$YESNO'=1
21REMARK1 ; loop to complete remarks field
22 D SETUP S DIR(0)="FO^1:30" D ^DIR Q:$D(DIRUT) S X=Y K DIR D ^DIC Q:+Y'>0 S DA=+Y,DIE="^DGBT(392.1,",DR="100",DR(2,392.1001)="5" D ^DIE K DIE
23 G REMARK1
24 Q
25ZIP ; list cities with missing zip codes, screen on fields that don't match 5N
26 I $$REPORT=1 D
27 . K DIC S DIC="^DGBT(392.1,",DIC(0)="EMZ",L=0,DIS(0)="I +$P($G(^DGBT(392.1,D0,0)),U,4)'>0",BY=".01",FLDS="[DGBT ZIP]",(FR,TO)=""
28 .S DHD="Incomplete zip code information in the Beneficiary Travel Distance File",DIOEND="D FTR^DGBTSRCH"
29 . D EN1^DIP K DIC
30 W !!,"Do you wish to update Zip Codes" Q:$$YESNO'=1
31ZIP1 ; loop to add zip codes
32 D SETUP D ^DIR Q:$D(DIRUT) S X=Y K DIR D ^DIC Q:+Y'>0 S DA=+Y,DIE="^DGBT(392.1,",DR="[DGBT ZIP]" D ^DIE K DIE
33 G ZIP1
34 Q
35MILES ; list those cities that have a null default mileage
36 I $$REPORT=1 D
37 . K DIC S DIC="^DGBT(392.1,",DIC(0)="EMZ",L=0,DIS(1)="I +$P($G(^DGBT(392.1,D0,0)),U,3)'>0",BY=".01",FLDS="[DGBT MILES]",(FR,TO)=""
38 . S DHD="Incomplete mileage information",DIOEND="D FTR^DGBTSRCH"
39 . D EN1^DIP K DIC
40 W !!,"Do you wish to update Mileage data" Q:$$YESNO'=1
41MILES1 ; add/edit default mileage and division mileage
42 D SETUP D ^DIR Q:$D(DIRUT) S X=Y K DIR D ^DIC Q:+Y'>0 S DA=+Y,DIE="^DGBT(392.1,",DR="[DGBT MILES]" D ^DIE K DIE
43 G MILES1
44 Q
45STCHK ;
46 S STREC="",DIE="^DGBT(392.1,",DR="2",STERR=0
47 F STREC=0:0 S STREC=$O(^DGBT(392.1,STREC)) Q:+STREC'>0 I $P($G(^DGBT(392.1,STREC,0)),U,2)']"" S STATE(STERR)=STREC,STERR=STERR+1
48 I STERR>0 W !!?5,*7,">> YOU HAVE ",STERR," ERROR(S) IN YOUR STATE IDENTIFIERS,",!?5,"THESE MUST BE CORRECTED BEFORE CONTINUING",! D
49 . F XX=0:1:STREC S DA=STATE(XX) W !,"City Name: ",$P($G(^DGBT(392.1,DA,0)),U,1)
50 . D ^DIE
51 K DIE,STATE,STREC,STERR,XX
52 Q
53YESNO() ;
54YN1 S %=2 D YN^DICN I %=0 W !,"Enter either YES or NO, '^' to Exit." G YN1
55 Q (+%)
56SETUP ; setup common variables for lookup and edit
57 S DIC="^DGBT(392.1,",(FR,TO)="",L=0,DIC(0)="EMZ",DIR(0)="FO^1:30",DIR("A")="ENTER NAME OF CITY TO CORRECT"
58 S DIR("?")="Enter the name of the city you wish to lookup, 1 to 30 characters in length"
59 Q
60OPTION() ; menu options in text form.
61 S X="SO^"
62 S X=X_"1:Additional Information Fields Marked;"
63 S X=X_"2:Missing Zip Codes;"
64 S X=X_"3:No Default or Division Mileages"
65 S DIR(0)=X,DIR("A")="Enter Option or [RETURN] to continue",DIR("?")="Enter the desired menu option mumber or either '^' or [RETURN] to add departure city"
66 D ^DIR K DIR
67 Q (+Y)
68REPORT() ; ask yes no to do report
69 W !!?5,"Print Report"
70RP1 S %=1 D YN^DICN I %=0 W !?5,"Enter 'Y'es or 'N'o" G RP1
71 Q (+%)
72 ;
73FTR ;
74 W !!?5,"NOTE:",!?5,"If no data prints, then no problems were found"
75 W !?5,"in the Distance file.",!
76 Q
Note: See TracBrowser for help on using the repository browser.