| [613] | 1 | IBY374PO ;PRXM/CMW - Post install routine for patch 374 ; 10 May 2007  9:41 AM
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**374**;21-MAR-94;Build 16
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; Call at tags only
 | 
|---|
 | 5 |  Q
 | 
|---|
 | 6 |  ; This routine will clean up entries in the file with NPIs delete status (2)
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 | EN ; Post Install Routine primary entry point
 | 
|---|
 | 9 |  ;
 | 
|---|
 | 10 |  D DEL
 | 
|---|
 | 11 |  D CLEAN
 | 
|---|
 | 12 |  Q
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 | DEL ; Look for NPI with delete status of "2"
 | 
|---|
 | 15 |  N IBIEN,STA,DA,IBOLDNPI
 | 
|---|
 | 16 |  S IBIEN=0
 | 
|---|
 | 17 |  F  S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN  D
 | 
|---|
 | 18 |  . S DA="A"
 | 
|---|
 | 19 |  . ; Loop through deleted NPIs (Status "2")
 | 
|---|
 | 20 |  . S STA=2
 | 
|---|
 | 21 |  . F  S DA=$O(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",STA,DA),-1) Q:'DA  D
 | 
|---|
 | 22 |  . . S IBOLDNPI=$P(^IBA(355.93,IBIEN,"NPISTATUS",DA,0),U,3)
 | 
|---|
 | 23 |  . . D COMP
 | 
|---|
 | 24 |  Q
 | 
|---|
 | 25 |  ;
 | 
|---|
 | 26 | COMP ;COMPLETELY DELETE THE NPI
 | 
|---|
 | 27 |  ;If NPI has status of "2" remove all entries related to this NPI.
 | 
|---|
 | 28 |  N OIEN
 | 
|---|
 | 29 |  S OIEN="A"
 | 
|---|
 | 30 |  F  S OIEN=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBOLDNPI,OIEN),-1) Q:'OIEN  D
 | 
|---|
 | 31 |  . NEW DIE,DIK,DIC,DA,DR,D,D0,DI,DIC,DQ,X
 | 
|---|
 | 32 |  . NEW DP,DM,DK,DL,DIEL
 | 
|---|
 | 33 |  . S DA(1)=IBIEN,DIK="^IBA(355.93,"_DA(1)_",""NPISTATUS"",",DA=OIEN
 | 
|---|
 | 34 |  . D ^DIK
 | 
|---|
 | 35 |  . ; kill 41.01 references
 | 
|---|
 | 36 |  . K ^IBA(355.93,"NPI",IBOLDNPI,DA),^IBA(355.93,"NPIHISTORY",IBOLDNPI,DA)
 | 
|---|
 | 37 |  Q
 | 
|---|
 | 38 |  ;
 | 
|---|
 | 39 | CLEAN ; Clean up ^IBA(355.93,IEN,"NPISTATUS",0) if there are no multiples in the sub-file.
 | 
|---|
 | 40 |  N IBIEN
 | 
|---|
 | 41 |  S IBIEN=0
 | 
|---|
 | 42 |  F  S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN  D
 | 
|---|
 | 43 |  . Q:$G(^IBA(355.93,IBIEN,"NPISTATUS",0))=""
 | 
|---|
 | 44 |  . I +$P($G(^IBA(355.93,IBIEN,"NPISTATUS",0)),U,4)=0 D
 | 
|---|
 | 45 |  . . K ^IBA(355.93,IBIEN,"NPISTATUS",0)
 | 
|---|
 | 46 |  Q
 | 
|---|