ADEAPC2 ; IHS/HQT/MJL - DENTAL PCC LINK PART 3 ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;**20**;APRIL 1999
;DELETES PCC DENTAL DEPENDENT ENTRIES
;ALSO DELETES VISIT ENTRY IF CALLED WITH ADENEWVS=1
Q:'$D(^ADEPCD(ADEDFN,"PCC"))
;------->GET VISIT DFN
S (ADEV,APCDALVR("APCDVSIT"))=$P(^ADEPCD(ADEDFN,"PCC"),U)
I '+ADEV S ADEY=0 G END
;------->DELETE V DENTAL ENTRIES
D DSERV
;------->DELETE V POV ENTRIES
D VPOV
;------->DELETE V PRV ENTRIES
D VPRV
;------->DELETE VISIT ENTRY IF NOT AN EDIT AND NO OTHER DEP. ENTRIES
I ADENEWVS,$D(^AUPNVSIT(ADEV,0)),'$P(^AUPNVSIT(ADEV,0),U,9) D
. S AUPNVSIT=ADEV
. D DEL^AUPNVSIT
. D ADDPCC("301///@",ADEDFN)
END Q
;
DSERV S ADENOD=$P(^ADEPCD(ADEDFN,"PCC"),U,4)
D:+ADENOD D1
D ADDPCC("304///@",ADEDFN)
;Previous versions stored data in non-Fileman-compatible nodes
;subscripted off ADEPCD(ADEDFN,"PCC"). Beginning with version
;5.4, these nodes are deleted when found.
S ADEG=0
F Q:ADEG="" S ADEG=$O(^ADEPCD(ADEDFN,"PCC",ADEG)) I +ADEG D
. S ADENOD=^ADEPCD(ADEDFN,"PCC",ADEG)
. D:+ADENOD D1
. K ^ADEPCD(ADEDFN,"PCC",ADEG) ;See above note
I $D(^ADEPCD(ADEDFN,"PCC1")) D
. S ADENOD=^ADEPCD(ADEDFN,"PCC1")
. D:+ADENOD D1
. D ADDPCC("401///@",ADEDFN)
I $D(^ADEPCD(ADEDFN,"PCC2")) D
. S ADENOD=^ADEPCD(ADEDFN,"PCC2")
. D:+ADENOD D1
. D ADDPCC("501///@",ADEDFN)
K ADEG,ADENOD
Q
D1 N ADELIM
S ADELIM="|"
I ADENOD[";" S ADELIM=";"
F ADECXX=1:1:$L(ADENOD,ADELIM) D
. S APCDALVR("APCDADFN")=$P(ADENOD,ADELIM,ADECXX)
. I APCDALVR("APCDADFN")]"" S DIK="^AUPNVDEN(",DA=APCDALVR("APCDADFN") D ^DIK
K ADELIM
Q
VPOV S APCDALVR("APCDDPOV")=$P(^ADEPCD(ADEDFN,"PCC"),U,2)
Q:APCDALVR("APCDDPOV")=""
S DIK="^AUPNVPOV(",DA=APCDALVR("APCDDPOV")
D ^DIK
D ADDPCC("302///@",ADEDFN)
Q
VPRV S APCDALVR("APCDDPRV")=$P(^ADEPCD(ADEDFN,"PCC"),U,3)
Q:APCDALVR("APCDDPRV")=""
S DIK="^AUPNVPRV(",DA=APCDALVR("APCDDPRV")
D ^DIK
D ADDPCC("303///@",ADEDFN)
Q
ADDPCC(DR,DA) ;EP
N DIE,DIDEL
S DIE="^ADEPCD("
S DIDEL=9002007
D ^DIE
K DIE,DIDEL
Q
ADEAPC2 ; IHS/HQT/MJL - DENTAL PCC LINK PART 3 ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;**20**;APRIL 1999
+2 ;DELETES PCC DENTAL DEPENDENT ENTRIES
+3 ;ALSO DELETES VISIT ENTRY IF CALLED WITH ADENEWVS=1
+4 IF '$DATA(^ADEPCD(ADEDFN,"PCC"))
QUIT
+5 ;------->GET VISIT DFN
+6 SET (ADEV,APCDALVR("APCDVSIT"))=$PIECE(^ADEPCD(ADEDFN,"PCC"),U)
+7 IF '+ADEV
SET ADEY=0
GOTO END
+8 ;------->DELETE V DENTAL ENTRIES
+9 DO DSERV
+10 ;------->DELETE V POV ENTRIES
+11 DO VPOV
+12 ;------->DELETE V PRV ENTRIES
+13 DO VPRV
+14 ;------->DELETE VISIT ENTRY IF NOT AN EDIT AND NO OTHER DEP. ENTRIES
+15 IF ADENEWVS
IF $DATA(^AUPNVSIT(ADEV,0))
IF '$PIECE(^AUPNVSIT(ADEV,0),U,9)
Begin DoDot:1
+16 SET AUPNVSIT=ADEV
+17 DO DEL^AUPNVSIT
+18 DO ADDPCC("301///@",ADEDFN)
End DoDot:1
END QUIT
+1 ;
DSERV SET ADENOD=$PIECE(^ADEPCD(ADEDFN,"PCC"),U,4)
+1 IF +ADENOD
DO D1
+2 DO ADDPCC("304///@",ADEDFN)
+3 ;Previous versions stored data in non-Fileman-compatible nodes
+4 ;subscripted off ADEPCD(ADEDFN,"PCC"). Beginning with version
+5 ;5.4, these nodes are deleted when found.
+6 SET ADEG=0
+7 FOR
IF ADEG=""
QUIT
SET ADEG=$ORDER(^ADEPCD(ADEDFN,"PCC",ADEG))
IF +ADEG
Begin DoDot:1
+8 SET ADENOD=^ADEPCD(ADEDFN,"PCC",ADEG)
+9 IF +ADENOD
DO D1
+10 ;See above note
KILL ^ADEPCD(ADEDFN,"PCC",ADEG)
End DoDot:1
+11 IF $DATA(^ADEPCD(ADEDFN,"PCC1"))
Begin DoDot:1
+12 SET ADENOD=^ADEPCD(ADEDFN,"PCC1")
+13 IF +ADENOD
DO D1
+14 DO ADDPCC("401///@",ADEDFN)
End DoDot:1
+15 IF $DATA(^ADEPCD(ADEDFN,"PCC2"))
Begin DoDot:1
+16 SET ADENOD=^ADEPCD(ADEDFN,"PCC2")
+17 IF +ADENOD
DO D1
+18 DO ADDPCC("501///@",ADEDFN)
End DoDot:1
+19 KILL ADEG,ADENOD
+20 QUIT
D1 NEW ADELIM
+1 SET ADELIM="|"
+2 IF ADENOD[";"
SET ADELIM=";"
+3 FOR ADECXX=1:1:$LENGTH(ADENOD,ADELIM)
Begin DoDot:1
+4 SET APCDALVR("APCDADFN")=$PIECE(ADENOD,ADELIM,ADECXX)
+5 IF APCDALVR("APCDADFN")]""
SET DIK="^AUPNVDEN("
SET DA=APCDALVR("APCDADFN")
DO ^DIK
End DoDot:1
+6 KILL ADELIM
+7 QUIT
VPOV SET APCDALVR("APCDDPOV")=$PIECE(^ADEPCD(ADEDFN,"PCC"),U,2)
+1 IF APCDALVR("APCDDPOV")=""
QUIT
+2 SET DIK="^AUPNVPOV("
SET DA=APCDALVR("APCDDPOV")
+3 DO ^DIK
+4 DO ADDPCC("302///@",ADEDFN)
+5 QUIT
VPRV SET APCDALVR("APCDDPRV")=$PIECE(^ADEPCD(ADEDFN,"PCC"),U,3)
+1 IF APCDALVR("APCDDPRV")=""
QUIT
+2 SET DIK="^AUPNVPRV("
SET DA=APCDALVR("APCDDPRV")
+3 DO ^DIK
+4 DO ADDPCC("303///@",ADEDFN)
+5 QUIT
ADDPCC(DR,DA) ;EP
+1 NEW DIE,DIDEL
+2 SET DIE="^ADEPCD("
+3 SET DIDEL=9002007
+4 DO ^DIE
+5 KILL DIE,DIDEL
+6 QUIT
