| [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 | 
|---|