DGLOCK3 ;ALB/BOK,BAJ - PATIENT FILE MUMPS TRIGGER/DATA EDIT CHECKS ; 01/23/2006
;;5.3;PIMS;**489,527,1015,1016**;JUN 30, 2012;Build 20
; DG*5.3*688 BAJ 01/23/2006 Changed to support foreign confidential addresses
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
S X=DGX
Q
KILL1 F DGJZ=0:0 S DGJZ=$O(^DD(2,DGIZ,1,DGJZ)) Q:'DGJZ X ^(DGJZ,2)
Q
S1 K DGBZ F DGKZ=9:1:13,20 S DGBZ(DGKZ)=""
D KILL K DGBZ,DGIZ,DGJZ,DGKZ
Q
S2 K DGBZ F DGKZ=14:1:18 S DGBZ(DGKZ)=""
D KILL K DGBZ,DGIZ,DGJZ,DGKZ
Q
CAD ;Confidential Address Edit
I $S('$D(^DPT(DFN,.141)):1,$P(^(.141),U,9)'="Y":1,1:0) D
.D EN^DDIOL("Requirement for Confidential Address data not indicated...NO EDITING!","","$C(7),!?4") K X
Q
CADD ;Confidential Address Delete
;Called from input transform on Confidential Address fields
Q:'$D(^DPT(DFN,.141)) I $P(^(.141),"^",9)="N"!($P(^(.141),"^",1,6)="^^^^^") D Q
.N DGFDA,DGERR
.D CADM
.I $D(DGFDA) D
..N DGX
..S DGX=X
..D FILE^DIE("","DGFDA","DGERR")
..S X=DGX
;
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
ASK1 ;
Q:%'=1
D EN^DGCLEAR(DFN,"CONF")
D CADM
N DGX
S DGX=X
D FILE^DIE("","DGFDA","DGERR")
S X=DGX
Q
CADM ;Delete data from Confidential Address Categories
I $D(^DPT(DFN,.14)) D
.N DGIEN
.S DGIEN=0
.F S DGIEN=$O(^DPT(DFN,.14,DGIEN)) Q:'DGIEN D
..S DGFDA(2.141,DGIEN_","_DFN_",",.01)=""
Q
CADD1 ;Confidential Address Delete
;Called from Confidential Address "DEL" nodes
I $D(^DPT(DFN,.141)),$P(^(.141),U,9)="Y" D
.D EN^DDIOL("Answer NO to the 'CONFIDENTIAL ADDRESS ACTIVE' prompt to delete.","","$C(7),!?4") K X
Q
DGLOCK3 ;ALB/BOK,BAJ - PATIENT FILE MUMPS TRIGGER/DATA EDIT CHECKS ; 01/23/2006
+1 ;;5.3;PIMS;**489,527,1015,1016**;JUN 30, 2012;Build 20
+2 ; DG*5.3*688 BAJ 01/23/2006 Changed to support foreign confidential addresses
KILL SET DGX=X
IF $DATA(^DPT(DFN,.32))
FOR DGKZ=0:0
SET DGKZ=$ORDER(DGBZ(DGKZ))
IF 'DGKZ
QUIT
SET X=$PIECE(^DPT(DFN,.32),"^",DGKZ)
SET $PIECE(^(.32),"^",DGKZ)=""
IF X]""
SET DGIZ=$SELECT(DGKZ=20:.32945,1:(DGKZ/10000+.3281))
IF $DATA(^DD(2,DGIZ,1))
DO KILL1
+1 SET X=DGX
+2 QUIT
KILL1 FOR DGJZ=0:0
SET DGJZ=$ORDER(^DD(2,DGIZ,1,DGJZ))
IF 'DGJZ
QUIT
XECUTE ^(DGJZ,2)
+1 QUIT
S1 KILL DGBZ
FOR DGKZ=9:1:13,20
SET DGBZ(DGKZ)=""
+1 DO KILL
KILL DGBZ,DGIZ,DGJZ,DGKZ
+2 QUIT
S2 KILL DGBZ
FOR DGKZ=14:1:18
SET DGBZ(DGKZ)=""
+1 DO KILL
KILL DGBZ,DGIZ,DGJZ,DGKZ
+2 QUIT
CAD ;Confidential Address Edit
+1 IF $SELECT('$DATA(^DPT(DFN,.141)):1,$PIECE(^(.141),U,9)'="Y":1,1:0)
Begin DoDot:1
+2 DO EN^DDIOL("Requirement for Confidential Address data not indicated...NO EDITING!","","$C(7),!?4")
KILL X
End DoDot:1
+3 QUIT
CADD ;Confidential Address Delete
+1 ;Called from input transform on Confidential Address fields
+2 IF '$DATA(^DPT(DFN,.141))
QUIT
IF $PIECE(^(.141),"^",9)="N"!($PIECE(^(.141),"^",1,6)="^^^^^")
Begin DoDot:1
+3 NEW DGFDA,DGERR
+4 DO CADM
+5 IF $DATA(DGFDA)
Begin DoDot:2
+6 NEW DGX
+7 SET DGX=X
+8 DO FILE^DIE("","DGFDA","DGERR")
+9 SET X=DGX
End DoDot:2
End DoDot:1
QUIT
+10 ;
ASK WRITE !,"Do you want to delete all confidential address data"
SET %=2
DO YN^DICN
IF %Y["?"
WRITE !,"Answer 'Y'es to remove confidential address information, 'N'o to leave data in file"
GOTO ASK
ASK1 ;
+1 IF %'=1
QUIT
+2 DO EN^DGCLEAR(DFN,"CONF")
+3 DO CADM
+4 NEW DGX
+5 SET DGX=X
+6 DO FILE^DIE("","DGFDA","DGERR")
+7 SET X=DGX
+8 QUIT
CADM ;Delete data from Confidential Address Categories
+1 IF $DATA(^DPT(DFN,.14))
Begin DoDot:1
+2 NEW DGIEN
+3 SET DGIEN=0
+4 FOR
SET DGIEN=$ORDER(^DPT(DFN,.14,DGIEN))
IF 'DGIEN
QUIT
Begin DoDot:2
+5 SET DGFDA(2.141,DGIEN_","_DFN_",",.01)=""
End DoDot:2
End DoDot:1
+6 QUIT
CADD1 ;Confidential Address Delete
+1 ;Called from Confidential Address "DEL" nodes
+2 IF $DATA(^DPT(DFN,.141))
IF $PIECE(^(.141),U,9)="Y"
Begin DoDot:1
+3 DO EN^DDIOL("Answer NO to the 'CONFIDENTIAL ADDRESS ACTIVE' prompt to delete.","","$C(7),!?4")
KILL X
End DoDot:1
+4 QUIT
