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

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DGLOCK3 ;ALB/BOK - PATIENT FILE MUMPS TRIGGER/DATA EDIT CHECKS ; 28 NOV 86
2 ;;5.3;Registration;**489,527**;Aug 13, 1993
3KILL S DGX=X I $D(^DPT(DFN,.32)) F DGKZ=0:0 S DGKZ=$O(DGBZ(DGKZ)) Q:'DGKZ S X=$P(^DPT(DFN,.32),"^",DGKZ),$P(^(.32),"^",DGKZ)="" I X]"" S DGIZ=$S(DGKZ=20:.32945,1:(DGKZ/10000+.3281)) I $D(^DD(2,DGIZ,1)) D KILL1
4 S X=DGX
5 Q
6KILL1 F DGJZ=0:0 S DGJZ=$O(^DD(2,DGIZ,1,DGJZ)) Q:'DGJZ X ^(DGJZ,2)
7 Q
8S1 K DGBZ F DGKZ=9:1:13,20 S DGBZ(DGKZ)=""
9 D KILL K DGBZ,DGIZ,DGJZ,DGKZ
10 Q
11S2 K DGBZ F DGKZ=14:1:18 S DGBZ(DGKZ)=""
12 D KILL K DGBZ,DGIZ,DGJZ,DGKZ
13 Q
14CAD ;Confidential Address Edit
15 I $S('$D(^DPT(DFN,.141)):1,$P(^(.141),U,9)'="Y":1,1:0) D
16 .D EN^DDIOL("Requirement for Confidential Address data not indicated...NO EDITING!","","$C(7),!?4") K X
17 Q
18CADD ;Confidential Address Delete
19 ;Called from input transform on Confidential Address fields
20 Q:'$D(^DPT(DFN,.141)) I $P(^(.141),"^",9)="N"!($P(^(.141),"^",1,6)="^^^^^") D Q
21 .N DGFDA,DGERR
22 .D CADM
23 .I $D(DGFDA) D
24 ..N DGX
25 ..S DGX=X
26 ..D FILE^DIE("","DGFDA","DGERR")
27 ..S X=DGX
28 ;
29ASK W !,"Do you want to delete all confidential address data" S %=2 D YN^DICN I %Y["?" W !,"Answer 'Y'es to remove confidential address information, 'N'o to leave data in file" G ASK
30ASK1 ;
31 Q:%'=1
32 ;S DGTEMPH=$P(^DPT(DFN,.141),"^",7,8),^(.141)="^^^^^^"_DGTEMPH_"^N^^" K DGTEMPH
33 N DGFDA,DGERR,DGX,DGFLD
34 F DGFLD=.1411,.1412,.1413,.1414,.1415,.1416,.14111 S DGFDA(2,DFN_",",DGFLD)=""
35 D CADM
36 S DGX=X
37 D FILE^DIE("","DGFDA","DGERR")
38 S X=DGX
39 Q
40CADM ;Delete data from Confidential Address Categories
41 I $D(^DPT(DFN,.14)) D
42 .N DGIEN
43 .S DGIEN=0
44 .F S DGIEN=$O(^DPT(DFN,.14,DGIEN)) Q:'DGIEN D
45 ..S DGFDA(2.141,DGIEN_","_DFN_",",.01)=""
46 Q
47CADD1 ;Confidential Address Delete
48 ;Called from Confidential Address "DEL" nodes
49 I $D(^DPT(DFN,.141)),$P(^(.141),U,9)="Y" D
50 .D EN^DDIOL("Answer NO to the 'CONFIDENTIAL ADDRESS ACTIVE' prompt to delete.","","$C(7),!?4") K X
51 Q
Note: See TracBrowser for help on using the repository browser.