- 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
