source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYQPOST.m@ 724

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1DGYQPOST ;AISC/TET - POST INIT TO PATCH DG*5.3*41
2 ;;5.3;Registration;**41**;Aug 13, 1993
3EN ;entry point for entire post init
4 D RCOMP,WARD,DOB
5 Q
6RCOMP ;entry point to re-compile templates
7 N DGDASH,DGMAX,DGROU,DGTEMP,I
8 S:'$D(DTIME) DTIME=300 S U="^",$P(DGDASH,"=",81)="",DGMAX=$G(^DD("ROU")) S:'DGMAX DGMAX=5000
9 W !!?17,"Recompilation of affected Registration Input Templates",!,DGDASH,!
10 F I=1:1 S DGTEMP=$P($T(ITEMP+I),";;",2) Q:DGTEMP="END" W !?5,DGTEMP D
11 .N DMAX,DGIEN,DGROU,X,Y
12 .S DGIEN=$O(^DIE("B",DGTEMP,0)) Q:'DGIEN
13 .S DGROU=$G(^DIE(DGIEN,"ROUOLD")) I DGROU']""!('$D(^DIE(DGIEN,0))) Q
14 .S X=$P(DGROU,U),DMAX=DGMAX,Y=DGIEN D EN^DIEZ
15 .W !?5,"===> ",DGTEMP," input template recompiled.",!
16 ;Q
17ITEMP ;input templates to be recompiled
18 ;;DGPM ADMIT
19 ;;DGPM ASIH ADMIT
20 ;;DGPM SPECIALTY TRANSFER
21 ;;DVBA C ADD 2507 PAT
22 ;;END
23 Q
24WARD ;delete .001 field from ward location file (#42), if exists
25 I $D(^DD(42,.001)) D
26 .N DA,DIC,DIK
27 .W !!,"Deleting the Number field (#.001) from the WARD LOCATION file (#42)."
28 .S DIK="^DD(42,",DA=".001",DA(1)=42 D ^DIK K DIK,DA
29 .W !?10," ... Deleted",!
30 Q
31DOB ;entry point to remove value from latest dob field (#.07) in period of service file (#21)
32 W !!,">>>> Modifying data in the Period of Service File (#21)..."
33 W !," >>>> Deleting the Latest DOB Field (#.07) for select entries",!
34 N DIC,DIE,DA,DR,X,Y,DGX,DGERR
35 S DIC="^DIC(21,"
36 S DIC(0)="XZ"
37 F DGX="PERSIAN GULF WAR","OPERATION DESERT SHIELD" D Q:$G(DGERR)
38 .S X=DGX
39 .D ^DIC
40 .I Y'>0 D
41 ..W !!,"*****"
42 ..W ?7,"There was a problem identifying the following PERIOD OF SERVICE"
43 ..W !?7,"entry: ",DGX,!
44 ..S DGERR=1
45 .I Y>0 D
46 ..W !!,"IEN= ",+Y,?10," Period of Service: ",$P(Y,U,2)
47 ..S DA=+Y,DIE=DIC,DR=".07///@"
48 ..D ^DIE
49 ..W ", Field #.07 deleted.",!
50 D:$G(DGERR) ERRMESS
51 W:'$G(DGERR) !!,"Done."
52 Q
53ERRMESS ;
54 W !!!!
55 F X=1:1 S DGX=$T(MESS+X) Q:$G(DGX)="" W !,$P(DGX,";;",2)
56 Q
57MESS ;
58 ;;It appears as if the PERIOD OF SERVICE File (#21) has been locally
59 ;;modified at this site.
60 ;;
61 ;;The PERIOD OF SERVICE file contains entries as determined by VACO
62 ;;MAS. Alteration of existing entries or addition of new ones will
63 ;;undoubtedly have a negative impact on the efficient operation of the
64 ;;MAS module and other modules.
65 ;;
66 ;;Please contact your Support ISC before continuing. This routine,
67 ;;at tag DOB^DGYQPOST, may be re-run multiple times.
Note: See TracBrowser for help on using the repository browser.