Routine: DGLOCK3

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

KILL1 F DGJZ=0:0 S DGJZ=$O(^DD(2,DGIZ,1,DGJZ)) Q:'DGJZ  X ^(DGJZ,2)

S1 K DGBZ F DGKZ=9:1:13,20 S DGBZ(DGKZ)=""

 D KILL K DGBZ,DGIZ,DGJZ,DGKZ

S2 K DGBZ F DGKZ=14:1:18 S DGBZ(DGKZ)=""

 D KILL K DGBZ,DGIZ,DGJZ,DGKZ

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

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

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)=""

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

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

DGLOCK3.m