Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDPCCL7

ACDPCCL7.m

Go to the documentation of this file. 
  1. ACDPCCL7 ;IHS/ADC/EDE/KML - PCC LINK - EDIT ENTRY;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. START ;
  1.  D MAIN
  1.  Q
  1.  ;
  1. MAIN ;
  1.  S X=$O(ACDPCCL(ACDDFNP,ACDVIEN,""))
  1.  I X="CS" D CS Q
  1.  D IIFTDC
  1.  Q
  1.  ;
  1. IIFTDC ;
  1.  D VFILES
  1.  D VISIT
  1.  S DIK="^ACDVIS("_ACDVIEN_",21,",DA=1,DA(1)=ACDVIEN D DIK^ACDFMC
  1.  Q
  1.  ;
  1. VFILES ; DELETE V FILE ENTRIES
  1.  S ACDY=0
  1.  F  S ACDY=$O(^ACDVIS(ACDVIEN,21,1,11,ACDY)) Q:'ACDY  I $D(^(ACDY,0)) S X=^(0) D
  1.  .  S ACDVF=$P(X,U)
  1.  .  S ACDVFE=$P(X,U,2)
  1.  . ;S X=$$DEL^APCDALVR(ACDVF,ACDVFE)
  1.  .  S X=$$DEL(ACDVF,ACDVFE)
  1.  .  I X D ERROR^ACDPCCL("Error code="_X_" encountered while deleting V File entry",3) Q
  1.  .  Q
  1.  Q
  1.  ;
  1. VISIT ; DELETE VISIT IF DEPENDENT ENTRY COUNT = 0
  1.  Q:'$D(^ACDVIS(ACDVIEN,21,1,0))  ;         corrupt cdmis visit
  1.  S X=^ACDVIS(ACDVIEN,21,1,0)
  1.  NEW AUPNVSIT
  1.  S AUPNVSIT=$P(X,U,2)
  1.  Q:$P(^AUPNVSIT(AUPNVSIT,0),U,9)
  1.  D DEL^AUPNVSIT
  1.  Q
  1.  ;
  1. CS ;
  1.  S ACDCSIEN=0
  1.  F  S ACDCSIEN=$O(ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCSIEN)) Q:'ACDCSIEN  D CS2 K ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCSIEN)
  1.  I '$O(ACDPCCL(ACDDFNP,ACDVIEN,"")) K ACDPCCL(ACDDFNP,ACDVIEN)
  1.  ; *** The kills above will preclude any CS entry ever being added
  1.  ; *** back by the add logic in ^ACDPCCL5.  Might rethink this.
  1.  Q
  1.  ;
  1. CS2 ;
  1.  I $D(^ACDVIS(ACDVIEN,21,"AC",ACDCSIEN)) S ACDDMIEN=$O(^(ACDCSIEN,0)),ACDVMIEN=$O(^(ACDDMIEN,0)) D
  1.  .  S ACDPCCV=$P($G(^ACDVIS(ACDVIEN,21,ACDDMIEN,0)),U,2)
  1.  .  Q:'ACDPCCV  ;                          quit if no PCC visit ien
  1.  .  S X=$G(^ACDVIS(ACDVIEN,21,ACDDMIEN,11,ACDVMIEN,0))
  1.  .  S ACDVCPT=$P(X,U,2) ;                  get ^AUPNVCPT ien
  1.  .  Q:'ACDVCPT
  1.  .  I ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCSIEN)="D" D CSDEL Q
  1.  . ;if CS entry deleted delete AUPNVCPT entry and ACDVIS mult entry
  1.  .  S ACDCSIEN=$P(X,U,3) ;                 get ^ACDCS ien
  1.  .  Q:'ACDCSIEN
  1.  .  S X=+$G(^AUPNVCPT(ACDVCPT,0)) ;        get CPT code from PCC
  1.  .  Q:'X
  1.  .  S Y=$P($G(^ACDCS(ACDCSIEN,0)),U,2) ;   get ^ACDSERV ien
  1.  .  Q:'Y
  1.  .  S Y=$P($G(^ACDSERV(Y,0)),U,5) ;        get CPT code from CDMIS
  1.  .  Q:'Y
  1.  .  Q:X=Y  ;                               quit if CPT codes same
  1.  .  S APCDALVR("APCDLOOK")=ACDVCPT
  1.  .  S APCDALVR("APCDTCPT")=Y
  1.  .  S APCDALVR("APCDVSIT")=ACDPCCV
  1.  .  S APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (MOD)]"
  1.  .  D ^APCDALVR
  1.  .  I $D(APCDALVR("APCDAFLG")) D ERROR^ACDPCCL("Error flag="_APCDALVR("APCDAFLG")_" returned by APCDALVR while modifying the V CPT file.",3)
  1.  .  K APCDALVR
  1.  .  Q
  1.  Q
  1.  ;
  1. CSDEL ; DELETED CS ENTRY
  1.  S X=$$DEL(9000010.18,ACDVCPT)
  1.  I X D ERROR^ACDPCCL("Error code="_X_" encountered while deleting V File entry",3)
  1.  I $D(^ACDVIS(ACDVIEN,21,"AC",ACDCSIEN)) S ACDDMIEN=$O(^(ACDCSIEN,0)),ACDVMIEN=$O(^(ACDDMIEN,0)) D
  1.  S DIK="^ACDVIS("_ACDVIEN_",21,"_ACDDMIEN_",11,",DA=ACDVMIEN,DA(1)=ACDDMIEN,DA(2)=ACDVIEN
  1.  D DIK^ACDFMC
  1.  Q
  1.  ;
  1.  ; ***** CHG CALL TO $$DEL^APCDALVR WHEN RELEASED *****
  1. DEL(DIK,DA) ; DELETE ONE V FILE ENTRY
  1.  ;
  1.  ; Meaning of returned values are:
  1.  ;    0 = v file entry deleted
  1.  ;    1 = data global invalid
  1.  ;    2 = no 0th node for data global
  1.  ;    3 = specified file is not a v file
  1.  ;    4 = specified entry is not in specified v file
  1.  ;
  1.  S:DIK DIK=$G(^DIC(DIK,0,"GL")) ;    get data gbl if file #
  1.  I DIK'?1"^".E1"(".E Q 1  ;          data gbl invalid
  1.  S X=$E(DIK,$L(DIK)) ;               get last chr of gbl
  1.  I X'="(",X'="," Q 1  ;              data gbl invalid
  1.  I '$D(@(DIK_"0)")) Q 2  ;           no 0th node for data gbl
  1.  S X=+$P(@(DIK_"0)"),U,2) ;          get file #
  1.  I $P(X,".")'=9000010 Q 3  ;         not a v file
  1.  I X=9000010 Q 3  ;                  not a v file
  1.  I '$D(@(DIK_DA_",0)")) Q 4  ;       entry not in v file
  1.  D DIK^ACDFMC ;                      delete v file entry
  1.  Q 0