[613] | 1 | DGLOCK3 ;ALB/BOK - PATIENT FILE MUMPS TRIGGER/DATA EDIT CHECKS ; 28 NOV 86
|
---|
| 2 | ;;5.3;Registration;**489,527**;Aug 13, 1993
|
---|
| 3 | KILL 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
|
---|
| 6 | KILL1 F DGJZ=0:0 S DGJZ=$O(^DD(2,DGIZ,1,DGJZ)) Q:'DGJZ X ^(DGJZ,2)
|
---|
| 7 | Q
|
---|
| 8 | S1 K DGBZ F DGKZ=9:1:13,20 S DGBZ(DGKZ)=""
|
---|
| 9 | D KILL K DGBZ,DGIZ,DGJZ,DGKZ
|
---|
| 10 | Q
|
---|
| 11 | S2 K DGBZ F DGKZ=14:1:18 S DGBZ(DGKZ)=""
|
---|
| 12 | D KILL K DGBZ,DGIZ,DGJZ,DGKZ
|
---|
| 13 | Q
|
---|
| 14 | CAD ;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
|
---|
| 18 | CADD ;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 | ;
|
---|
| 29 | ASK 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
|
---|
| 30 | ASK1 ;
|
---|
| 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
|
---|
| 40 | CADM ;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
|
---|
| 47 | CADD1 ;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
|
---|