| 1 | DGYQPOST ;AISC/TET - POST INIT TO PATCH DG*5.3*41
|
|---|
| 2 | ;;5.3;Registration;**41**;Aug 13, 1993
|
|---|
| 3 | EN ;entry point for entire post init
|
|---|
| 4 | D RCOMP,WARD,DOB
|
|---|
| 5 | Q
|
|---|
| 6 | RCOMP ;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
|
|---|
| 17 | ITEMP ;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
|
|---|
| 24 | WARD ;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
|
|---|
| 31 | DOB ;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
|
|---|
| 53 | ERRMESS ;
|
|---|
| 54 | W !!!!
|
|---|
| 55 | F X=1:1 S DGX=$T(MESS+X) Q:$G(DGX)="" W !,$P(DGX,";;",2)
|
|---|
| 56 | Q
|
|---|
| 57 | MESS ;
|
|---|
| 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.
|
|---|
